pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

LazStats: Fix crash in some spc forms when groups contain less than 2 values.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7672 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-09-20 12:45:38 +00:00
parent a67c29af62
commit 2c8c8c7256
6 changed files with 69 additions and 40 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
applications/lazstats/source/forms/analysis/statistical_process_control/basicspcunit.pas
View File

@ -49,7 +49,7 @@ type
procedure ResetBtnClick(Sender: TObject);
procedure VarListClick(Sender: TObject);
private
FNoGroupsAllowed: Boolean;
FGroupsNeeded: Boolean;
protected
GrpVar: Integer;
@ -67,7 +67,7 @@ type
public
FReportFrame: TReportFrame;
FChartFrame: TChartFrame;
property NoGroupsAllowed: Boolean read FNoGroupsAllowed write FNoGroupsAllowed;
property GroupsNeeded: Boolean read FgroupsNeeded write FGroupsNeeded;
end;
@ -124,7 +124,7 @@ begin
if GroupEdit.Visible and (cellstring = GroupEdit.Text) then GrpVar := i;
if MeasEdit.Visible and (cellstring = MeasEdit.Text) then MeasVar := i;
end;
if not NoGroupsAllowed and GroupEdit.Visible and (GrpVar = -1) then
if GroupsNeeded and GroupEdit.Visible and (GrpVar = -1) then
begin
GroupEdit.SetFocus;
ErrorMsg('Group variable not found.');

9
applications/lazstats/source/forms/analysis/statistical_process_control/cusumunit.lfm
View File

@ -433,4 +433,13 @@ inherited CUSUMChartForm: TCUSUMChartForm
end
end
end
inherited SpecsSplitter: TSplitter
Left = 443
Height = 503
end
inherited PageControl: TPageControl
Left = 451
Height = 491
Width = 543
end
end

68
applications/lazstats/source/forms/analysis/statistical_process_control/cusumunit.pas
View File

@ -74,13 +74,13 @@ var
target, stdDev, diff, grandMean, grandSD, aveSD: Double;
delta, alpha, beta: double;
grp: String;
individuals: Boolean;
individuals: Boolean; // Signals that there is no "Groups" column
UCL: Double = NaN;
LCL: Double = NaN;
groups: StrDyneVec = nil;
means: DblDyneVec = nil;
stdDevs: DblDyneVec = nil;
count: IntDyneVec = nil;
// count: Integer; //: IntDyneVec = nil;
ColNoSelected: IntDyneVec = nil;
lReport: TStrings;
@ -104,19 +104,46 @@ begin
grpSize := 0;
oldGrpSize := 0;
SetLength(count, numGrps);
SetLength(means, numGrps);
SetLength(stdDevs, numGrps);
grandMean := 0.0;
grandSD := 0.0;
// Count "good" data points
// Count "good" data points (for grand mean and grand std dev).
numValues := 0;
for i := 1 to NoCases do
if GoodRecord(i, Length(ColNoSelected), ColNoSelected) then inc(numValues);
// calculate group ranges, grand mean, group sd's, semeans
// Get group size
if individuals then
grpSize := 1
else
begin
for j := 0 to numGrps - 1 do // groups
begin
grpSize := 0;
for i := 1 to NoCases do
begin
if not GoodRecord(i, Length(ColNoSelected), ColNoSelected) then continue;
grp := Trim(OS3MainFrm.DataGrid.Cells[GrpVar, i]);
grpIndex := IndexOfString(groups, grp);
if grpIndex = j then
inc(grpSize);
end; // next case
if j = 0 then
oldgrpSize := grpSize
else
if (oldGrpSize <> grpSize) then
begin
ErrorMsg('All groups must have the same size.');
exit;
end;
end; // next group
end;
// Calculate group ranges, grand mean, group sd's, SEMeans
if individuals or (grpSize < 2) then
begin
// x-bar chart of individual measurements, no groups
grpIndex := 0;
@ -126,7 +153,6 @@ begin
if not GoodRecord(i, Length(ColNoSelected), ColNoSelected) then continue;
X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[MeasVar, i]));
Xsq := X*X;
count[i] := 1;
groups[grpIndex] := IntToStr(i);
means[grpIndex] := means[grpIndex] + X;
if not IsNaN(prevX) then
@ -151,7 +177,6 @@ begin
begin
X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[MeasVar, i]));
Xsq := X * X;
inc(count[grpIndex]);
means[grpIndex] := means[grpIndex] + X;
stdDevs[grpIndex] := stdDevs[grpIndex] + Xsq;
grandMean := grandMean + X;
@ -159,14 +184,6 @@ begin
end;
end; // next case
grpSize := count[j];
if j = 0 then oldgrpSize := grpSize;
if (oldGrpSize <> grpSize) then
begin
ErrorMsg('All groups must have the same size.');
exit;
end;
stdDevs[j] := stdDevs[j] - sqr(means[j]) / grpSize;
stdDevs[j] := stdDevs[j] / (grpSize - 1);
stdDevs[j] := sqrt(stdDevs[j]);
@ -175,9 +192,9 @@ begin
end;
grandSD := grandSD - sqr(grandMean) / numValues;
grandSD := sqrt(grandSD / (numValues - 1));
SEMean := grandSD / sqrt(numValues);
grandMean := grandMean/numValues; // mean of all observations
grandSD := sqrt(grandSD / (numValues - 1)); // std dev of all (ungrouped) values
SEMean := grandSD / sqrt(numValues); // std error of grand mean
grandMean := grandMean/numValues; // grand mean of all observations
if individuals then
begin
aveSD := 0;
@ -234,7 +251,7 @@ begin
CUSumsUpper[0] := 0; //Max(0, diff);
SetLength(CUSumsLower, numGrps);
FillChar(CUSumsLower[0], numGrps*SizeOf(Double), 0);
CUSumsLower[0] := 0; //Max(0, diff);
CUSumsLower[0] := 0; //Min(0, diff);
end;
for j := 1 to numGrps-1 do
begin
@ -255,7 +272,7 @@ begin
lReport.Clear;
lReport.Add ('CUSUM Chart Results');
lReport.Add ('');
lReport.Add ('Number of Values: %8d', [numValues]);
lReport.Add ('Number of values: %8d', [numValues]);
lReport.Add ('Number of groups: %8d', [numGrps]);
lReport.Add ('Group size: %8d', [grpSize]);
lReport.Add ('');
@ -264,10 +281,12 @@ begin
lReport.Add ('Standard error of Mean: %8.3f', [SEMean]);
lReport.Add ('Target specification: %8.3f', [target]);
lReport.Add ('Average group std dev: %8.3f', [aveSD]);
lReport.Add ('');
if rbTabular.Checked then
begin
lReport.Add ('UCL: %8.3f', [h]);
lReport.Add ('LCL: %8.3f', [-h]);
lReport.Add ('');
lReport.Add ('Tabular CUSUM parameters:');
lReport.Add (' k: %8.3f (%s sigma)', [k, kEdit.Text]);
lReport.Add (' h: %8.3f (%s sigma)', [h, hEdit.Text]);
@ -279,7 +298,7 @@ begin
for i := 0 to numGrps - 1 do
begin
lReport.Add('%5s %4d %8.3f %8.3f %9.3f %9.3f', [
groups[i], count[i], means[i], means[i]-target, CUSumsUpper[i], CUSumsLower[i]
groups[i], grpSize, means[i], means[i]-target, CUSumsUpper[i], CUSumsLower[i]
]);
end;
end;
@ -288,6 +307,7 @@ begin
begin
if DeltaEdit.Text <> '' then
begin
lReport.Add ('');
lReport.Add('V-Mask parameters:');
lReport.Add(' Alpha (Type I error) %8.3f', [alpha]);
lReport.Add(' Beta (Type II error) %8.3f', [beta]);
@ -301,7 +321,7 @@ begin
for i := 0 to numGrps - 1 do
begin
lReport.Add('%5s %4d %8.3f %8.3f %10.3f', [
groups[i], count[i], means[i], means[i]-target, cusums[i]
groups[i], grpSize, means[i], means[i]-target, cusums[i]
]);
end;
end;
@ -330,8 +350,6 @@ procedure TCUSUMChartForm.FormActivate(Sender: TObject);
var
w: Integer;
begin
NoGroupsAllowed := true;
w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]);
HelpBtn.Constraints.MinWidth := w;
ResetBtn.Constraints.MinWidth := w;

3
applications/lazstats/source/forms/analysis/statistical_process_control/rchartunit.pas
View File

@ -9,6 +9,9 @@ uses
BasicSPCUnit;
type
{ TRChartForm }
TRChartForm = class(TBasicSPCForm)
protected
procedure Compute; override;

21
applications/lazstats/source/forms/analysis/statistical_process_control/schartunit.pas
View File

@ -98,24 +98,25 @@ begin
grandMean := grandMean + X;
end;
end; // next case
stddev[j] := stddev[j] - sqr(means[j]) / count[j];
stddev[j] := stddev[j] / (count[j] - 1);
stddev[j] := sqrt(stddev[j]);
means[j] := means[j] / count[j];
grandSigma := grandSigma + stddev[j];
grpSize := count[j];
if (grpSize < 2) then
begin
ErrorMsg('Groups with at least two values required.');
exit;
end;
if j = 0 then oldGrpSize := grpSize;
if oldGrpSize <> grpSize then
begin
ErrorMsg('All groups must have the same size.');
exit;
end;
end;
if (grpSize < 2) then
begin
ErrorMsg('Groups with at least two values required.');
exit;
stddev[j] := stddev[j] - sqr(means[j]) / count[j];
stddev[j] := stddev[j] / (count[j] - 1);
stddev[j] := sqrt(stddev[j]);
means[j] := means[j] / count[j];
grandSigma := grandSigma + stddev[j];
end;
seMean := seMean - sqr(grandMean)/numValues;

2
applications/lazstats/source/forms/analysis/statistical_process_control/xbarchartunit.pas
View File

@ -69,8 +69,6 @@ procedure TXBarChartForm.FormActivate(Sender: TObject);
var
w: Integer;
begin
NoGroupsAllowed := true;
w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]);
HelpBtn.Constraints.MinWidth := w;
ResetBtn.Constraints.MinWidth := w;