From 2c8c8c72564336e2b3cc89c3390b43d9c15455c4 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sun, 20 Sep 2020 12:45:38 +0000 Subject: [PATCH] LazStats: Fix crash in some spc forms when groups contain less than 2 values. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7672 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../basicspcunit.pas | 6 +- .../statistical_process_control/cusumunit.lfm | 9 +++ .../statistical_process_control/cusumunit.pas | 68 ++++++++++++------- .../rchartunit.pas | 3 + .../schartunit.pas | 21 +++--- .../xbarchartunit.pas | 2 - 6 files changed, 69 insertions(+), 40 deletions(-) diff --git a/applications/lazstats/source/forms/analysis/statistical_process_control/basicspcunit.pas b/applications/lazstats/source/forms/analysis/statistical_process_control/basicspcunit.pas index be9ea0e58..3adf0c939 100644 --- a/applications/lazstats/source/forms/analysis/statistical_process_control/basicspcunit.pas +++ b/applications/lazstats/source/forms/analysis/statistical_process_control/basicspcunit.pas @@ -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.'); diff --git a/applications/lazstats/source/forms/analysis/statistical_process_control/cusumunit.lfm b/applications/lazstats/source/forms/analysis/statistical_process_control/cusumunit.lfm index e97acdcf9..662067391 100644 --- a/applications/lazstats/source/forms/analysis/statistical_process_control/cusumunit.lfm +++ b/applications/lazstats/source/forms/analysis/statistical_process_control/cusumunit.lfm @@ -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 diff --git a/applications/lazstats/source/forms/analysis/statistical_process_control/cusumunit.pas b/applications/lazstats/source/forms/analysis/statistical_process_control/cusumunit.pas index aab4f7c41..54959ae26 100644 --- a/applications/lazstats/source/forms/analysis/statistical_process_control/cusumunit.pas +++ b/applications/lazstats/source/forms/analysis/statistical_process_control/cusumunit.pas @@ -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; diff --git a/applications/lazstats/source/forms/analysis/statistical_process_control/rchartunit.pas b/applications/lazstats/source/forms/analysis/statistical_process_control/rchartunit.pas index fc0c7d820..6157a31f0 100644 --- a/applications/lazstats/source/forms/analysis/statistical_process_control/rchartunit.pas +++ b/applications/lazstats/source/forms/analysis/statistical_process_control/rchartunit.pas @@ -9,6 +9,9 @@ uses BasicSPCUnit; type + + { TRChartForm } + TRChartForm = class(TBasicSPCForm) protected procedure Compute; override; diff --git a/applications/lazstats/source/forms/analysis/statistical_process_control/schartunit.pas b/applications/lazstats/source/forms/analysis/statistical_process_control/schartunit.pas index c55979739..4f6798480 100644 --- a/applications/lazstats/source/forms/analysis/statistical_process_control/schartunit.pas +++ b/applications/lazstats/source/forms/analysis/statistical_process_control/schartunit.pas @@ -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; diff --git a/applications/lazstats/source/forms/analysis/statistical_process_control/xbarchartunit.pas b/applications/lazstats/source/forms/analysis/statistical_process_control/xbarchartunit.pas index eb6b6a05d..b8b90f0d6 100644 --- a/applications/lazstats/source/forms/analysis/statistical_process_control/xbarchartunit.pas +++ b/applications/lazstats/source/forms/analysis/statistical_process_control/xbarchartunit.pas @@ -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;