LazStats: Add tabular form of CUSUM control charts.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7668 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-09-17 22:27:59 +00:00
parent 4a4cbb53ab
commit cc98b553d8
4 changed files with 695 additions and 342 deletions

View File

@ -324,7 +324,7 @@ begin
FChartFrame.SetXTitle(AXTitle); FChartFrame.SetXTitle(AXTitle);
FChartFrame.SetYTitle(AYTitle); FChartFrame.SetYTitle(AYTitle);
ser := FChartFrame.PlotXY(ptSymbols, nil, Means, Groups, nil, ADataTitle, clBlack); ser := FChartFrame.PlotXY(ptLinesAndSymbols, nil, Means, Groups, nil, ADataTitle, clBlack);
if Length(Groups) > 0 then if Length(Groups) > 0 then
begin begin
FChartFrame.Chart.BottomAxis.Marks.Source := ser.Source; FChartFrame.Chart.BottomAxis.Marks.Source := ser.Source;

View File

@ -1,18 +1,20 @@
inherited CUSUMChartForm: TCUSUMChartForm inherited CUSUMChartForm: TCUSUMChartForm
Height = 424 Height = 503
Width = 1000
HelpType = htKeyword HelpType = htKeyword
HelpKeyword = 'html/CUMSUMChart.htm' HelpKeyword = 'html/CUMSUMChart.htm'
Caption = 'Cumulative Sum Control Chart' Caption = 'Cumulative Sum Control Chart'
ClientHeight = 424 ClientHeight = 503
ClientWidth = 1000
OnActivate = FormActivate OnActivate = FormActivate
ShowHint = True ShowHint = True
inherited SpecsPanel: TPanel inherited SpecsPanel: TPanel
Height = 424 Height = 503
Width = 432 Width = 432
ClientHeight = 424 ClientHeight = 503
ClientWidth = 432 ClientWidth = 432
inherited ButtonPanel: TPanel inherited ButtonPanel: TPanel
Top = 382 Top = 461
Width = 432 Width = 432
ClientWidth = 432 ClientWidth = 432
TabOrder = 5 TabOrder = 5
@ -33,8 +35,8 @@ inherited CUSUMChartForm: TCUSUMChartForm
end end
end end
inherited VarList: TListBox inherited VarList: TListBox
Height = 349 Height = 428
Width = 188 Width = 196
end end
inherited GroupLabel: TLabel inherited GroupLabel: TLabel
Left = 236 Left = 236
@ -68,26 +70,245 @@ inherited CUSUMChartForm: TCUSUMChartForm
AnchorSideLeft.Control = GroupInBtn AnchorSideLeft.Control = GroupInBtn
Left = 205 Left = 205
end end
object GroupBox1: TGroupBox[12] object GroupBox2: TGroupBox[12]
AnchorSideLeft.Control = MeasEdit AnchorSideLeft.Control = MeasInBtn
AnchorSideTop.Control = GroupBox2 AnchorSideTop.Control = GroupEdit
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = MeasEdit AnchorSideRight.Control = MeasEdit
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 236 Left = 204
Height = 153 Height = 134
Top = 239 Top = 153
Width = 196 Width = 228
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
AutoSize = True AutoSize = True
BorderSpacing.Top = 16 BorderSpacing.Top = 20
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
Caption = 'Options:'
ClientHeight = 114
ClientWidth = 224
TabOrder = 3
object TargetChk: TCheckBox
AnchorSideLeft.Control = GroupBox2
AnchorSideTop.Control = TargetEdit
AnchorSideTop.Side = asrCenter
Left = 12
Height = 19
Top = 2
Width = 108
BorderSpacing.Left = 12
BorderSpacing.Right = 8
Caption = 'Use Target Specs'
TabOrder = 0
end
object TargetEdit: TEdit
AnchorSideLeft.Control = StdDevEdit
AnchorSideTop.Control = GroupBox2
AnchorSideRight.Control = GroupBox2
AnchorSideRight.Side = asrBottom
Left = 132
Height = 23
Top = 0
Width = 84
Alignment = taRightJustify
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Right = 8
BorderSpacing.Bottom = 4
Constraints.MinWidth = 64
TabOrder = 1
Text = 'TargetEdit'
end
object rbTabular: TRadioButton
AnchorSideLeft.Control = TargetChk
AnchorSideTop.Control = Bevel3
AnchorSideTop.Side = asrBottom
Left = 12
Height = 19
Top = 66
Width = 103
BorderSpacing.Top = 4
Caption = 'Tabular CUSUM'
Checked = True
OnChange = rbTabularChange
TabOrder = 4
TabStop = True
end
object Bevel3: TBevel
AnchorSideLeft.Control = GroupBox2
AnchorSideTop.Control = StdDevEdit
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GroupBox2
AnchorSideRight.Side = asrBottom
Left = 8
Height = 4
Top = 58
Width = 208
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 8
Shape = bsTopLine
end
object rbVMask: TRadioButton
AnchorSideLeft.Control = rbTabular
AnchorSideTop.Control = rbTabular
AnchorSideTop.Side = asrBottom
Left = 12
Height = 19
Top = 89
Width = 60
BorderSpacing.Top = 4
BorderSpacing.Bottom = 6
Caption = 'V-Mask'
OnChange = rbTabularChange
TabOrder = 5
end
object StdDevChk: TCheckBox
AnchorSideLeft.Control = GroupBox2
AnchorSideTop.Control = StdDevEdit
AnchorSideTop.Side = asrCenter
Left = 12
Height = 19
Top = 29
Width = 112
BorderSpacing.Left = 12
BorderSpacing.Right = 8
Caption = 'Use StdDev Specs'
TabOrder = 2
end
object StdDevEdit: TEdit
AnchorSideLeft.Control = StdDevChk
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = TargetEdit
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GroupBox2
AnchorSideRight.Side = asrBottom
Left = 132
Height = 23
Top = 27
Width = 84
Alignment = taRightJustify
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 4
Constraints.MinWidth = 64
TabOrder = 3
Text = 'StdDevEdit'
end
end
object Notebook: TNotebook[13]
AnchorSideLeft.Control = GroupBox2
AnchorSideTop.Control = GroupBox2
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GroupBox2
AnchorSideRight.Side = asrBottom
Left = 204
Height = 153
Top = 295
Width = 228
PageIndex = 0
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Bottom = 8
TabOrder = 4
object TabularPage: TPage
object TabularGroup: TGroupBox
AnchorSideLeft.Control = TabularPage
AnchorSideTop.Control = TabularPage
AnchorSideRight.Control = TabularPage
AnchorSideRight.Side = asrBottom
Left = 0
Height = 80
Top = 0
Width = 228
Anchors = [akTop, akLeft, akRight]
AutoSize = True
Caption = 'Tabulated CUSUM Parameters'
ClientHeight = 60
ClientWidth = 224
TabOrder = 0
object Label7: TLabel
AnchorSideTop.Control = kEdit
AnchorSideTop.Side = asrCenter
Left = 12
Height = 15
Top = 6
Width = 96
BorderSpacing.Left = 12
Caption = 'k (in StdDev units)'
ParentColor = False
end
object kEdit: TEdit
AnchorSideLeft.Control = hEdit
AnchorSideTop.Control = TabularGroup
AnchorSideRight.Control = TabularGroup
AnchorSideRight.Side = asrBottom
Left = 117
Height = 23
Hint = 'Detection level for a shift in the process mean, '#13#10'expressed in data units (default), or'#13#10'as a multiple of the standard deviation of the '#13#10'data points (when "Normalized CUSUM" is checked).'
Top = 2
Width = 99
Alignment = taRightJustify
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 2
BorderSpacing.Right = 8
Constraints.MinWidth = 64
TabOrder = 0
Text = 'kEdit'
end
object hEdit: TEdit
AnchorSideLeft.Control = Label8
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = kEdit
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = TabularGroup
AnchorSideRight.Side = asrBottom
Left = 117
Height = 23
Hint = 'Probability of concluding that a shift in the process has occurred, when in fact it did not. '
Top = 29
Width = 99
Alignment = taRightJustify
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 8
BorderSpacing.Top = 4
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Constraints.MinWidth = 64
TabOrder = 1
Text = 'hEdit'
end
object Label8: TLabel
AnchorSideTop.Control = hEdit
AnchorSideTop.Side = asrCenter
Left = 12
Height = 15
Top = 33
Width = 97
BorderSpacing.Left = 12
Caption = 'h (in StdDev units)'
ParentColor = False
end
end
end
object VMaskPage: TPage
object VMaskGroup: TGroupBox
AnchorSideLeft.Control = VMaskPage
AnchorSideTop.Control = VMaskPage
AnchorSideRight.Control = VMaskPage
AnchorSideRight.Side = asrBottom
Left = 0
Height = 153
Top = 0
Width = 228
Anchors = [akTop, akLeft, akRight]
AutoSize = True
Caption = 'V-Mask Specifications' Caption = 'V-Mask Specifications'
ClientHeight = 133 ClientHeight = 133
ClientWidth = 192 ClientWidth = 224
TabOrder = 4 TabOrder = 0
object Label4: TLabel object Label4: TLabel
AnchorSideLeft.Control = GroupBox1 AnchorSideLeft.Control = VMaskGroup
AnchorSideTop.Control = DeltaEdit AnchorSideTop.Control = DeltaEdit
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 12 Left = 12
@ -99,7 +320,7 @@ inherited CUSUMChartForm: TCUSUMChartForm
ParentColor = False ParentColor = False
end end
object Label5: TLabel object Label5: TLabel
AnchorSideLeft.Control = GroupBox1 AnchorSideLeft.Control = VMaskGroup
AnchorSideTop.Control = AlphaEdit AnchorSideTop.Control = AlphaEdit
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 12 Left = 12
@ -111,7 +332,7 @@ inherited CUSUMChartForm: TCUSUMChartForm
ParentColor = False ParentColor = False
end end
object Label6: TLabel object Label6: TLabel
AnchorSideLeft.Control = GroupBox1 AnchorSideLeft.Control = VMaskGroup
AnchorSideTop.Control = BetaEdit AnchorSideTop.Control = BetaEdit
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 12 Left = 12
@ -124,14 +345,14 @@ inherited CUSUMChartForm: TCUSUMChartForm
end end
object DeltaEdit: TEdit object DeltaEdit: TEdit
AnchorSideLeft.Control = AlphaEdit AnchorSideLeft.Control = AlphaEdit
AnchorSideTop.Control = GroupBox1 AnchorSideTop.Control = VMaskGroup
AnchorSideRight.Control = GroupBox1 AnchorSideRight.Control = VMaskGroup
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 114 Left = 114
Height = 23 Height = 23
Hint = 'Detection level for a shift in the process mean, '#13#10'expressed in data units (default), or'#13#10'as a multiple of the standard deviation of the '#13#10'data points (when "Normalized CUSUM" is checked).' Hint = 'Detection level for a shift in the process mean, '#13#10'expressed in data units (default), or'#13#10'as a multiple of the standard deviation of the '#13#10'data points (when "Normalized CUSUM" is checked).'
Top = 2 Top = 2
Width = 70 Width = 102
Alignment = taRightJustify Alignment = taRightJustify
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 2 BorderSpacing.Top = 2
@ -145,13 +366,13 @@ inherited CUSUMChartForm: TCUSUMChartForm
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = DeltaEdit AnchorSideTop.Control = DeltaEdit
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GroupBox1 AnchorSideRight.Control = VMaskGroup
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 114 Left = 114
Height = 23 Height = 23
Hint = 'Probability of concluding that a shift in the process has occurred, when in fact it did not. ' Hint = 'Probability of concluding that a shift in the process has occurred, when in fact it did not. '
Top = 29 Top = 29
Width = 70 Width = 102
Alignment = taRightJustify Alignment = taRightJustify
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 8 BorderSpacing.Left = 8
@ -165,13 +386,13 @@ inherited CUSUMChartForm: TCUSUMChartForm
AnchorSideLeft.Control = AlphaEdit AnchorSideLeft.Control = AlphaEdit
AnchorSideTop.Control = AlphaEdit AnchorSideTop.Control = AlphaEdit
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GroupBox1 AnchorSideRight.Control = VMaskGroup
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 114 Left = 114
Height = 23 Height = 23
Hint = 'Probability of not detecting that a shift in the process mean has, in fact, occurred' Hint = 'Probability of not detecting that a shift in the process mean has, in fact, occurred'
Top = 56 Top = 56
Width = 70 Width = 102
Alignment = taRightJustify Alignment = taRightJustify
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 4 BorderSpacing.Top = 4
@ -190,7 +411,7 @@ inherited CUSUMChartForm: TCUSUMChartForm
Left = 12 Left = 12
Height = 17 Height = 17
Top = 104 Top = 104
Width = 172 Width = 204
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 2 BorderSpacing.Top = 2
BorderSpacing.Bottom = 12 BorderSpacing.Bottom = 12
@ -209,95 +430,41 @@ inherited CUSUMChartForm: TCUSUMChartForm
ParentColor = False ParentColor = False
end end
end end
object GroupBox2: TGroupBox[13]
AnchorSideLeft.Control = GroupBox1
AnchorSideTop.Control = GroupEdit
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = MeasEdit
AnchorSideRight.Side = asrBottom
Left = 236
Height = 74
Top = 149
Width = 196
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BorderSpacing.Top = 16
BorderSpacing.Bottom = 8
Caption = 'Option:'
ClientHeight = 54
ClientWidth = 192
TabOrder = 3
object TargetChk: TCheckBox
AnchorSideLeft.Control = GroupBox2
AnchorSideTop.Control = TargetEdit
AnchorSideTop.Side = asrCenter
Left = 12
Height = 19
Top = 2
Width = 108
BorderSpacing.Left = 12
BorderSpacing.Right = 8
Caption = 'Use Target Specs'
TabOrder = 0
end
object TargetEdit: TEdit
AnchorSideLeft.Control = TargetChk
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = GroupBox2
AnchorSideRight.Control = GroupBox2
AnchorSideRight.Side = asrBottom
Left = 128
Height = 23
Top = 0
Width = 64
Alignment = taRightJustify
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 4
Constraints.MinWidth = 64
TabOrder = 1
Text = 'TargetEdit'
end
object ShowMeanDevChk: TCheckBox
AnchorSideLeft.Control = TargetChk
AnchorSideTop.Control = TargetEdit
AnchorSideTop.Side = asrBottom
Left = 12
Height = 19
Top = 27
Width = 169
BorderSpacing.Top = 4
BorderSpacing.Bottom = 8
Caption = 'Show mean group deviation'
TabOrder = 2
end end
end end
end end
inherited SpecsSplitter: TSplitter inherited SpecsSplitter: TSplitter
Left = 435 Left = 443
Height = 424 Height = 503
end end
inherited PageControl: TPageControl inherited PageControl: TPageControl
Left = 443 Left = 451
Height = 412 Height = 491
Width = 478 Width = 543
inherited ReportPage: TTabSheet inherited ReportPage: TTabSheet
ClientHeight = 384 ClientHeight = 463
ClientWidth = 470 ClientWidth = 535
inherited Panel1: TPanel inherited Panel1: TPanel
Height = 344 Height = 423
Width = 458 Width = 523
ClientHeight = 340 ClientHeight = 419
ClientWidth = 454 ClientWidth = 519
inherited ReportMemo: TMemo inherited ReportMemo: TMemo
Height = 332 Height = 411
Width = 446 Width = 511
end end
end end
inherited ReportToolBar: TToolBar inherited ReportToolBar: TToolBar
Width = 466 Width = 531
end end
end end
end end
inherited SaveDialog: TSaveDialog
Left = 600
Top = 112
end
inherited PrintDialog: TPrintDialog
Left = 600
Top = 200
end
end end

View File

@ -6,7 +6,7 @@ interface
uses uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, ExtCtrls, Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, ExtCtrls,
StdCtrls, Globals, BasicSPCUnit; StdCtrls, Buttons, PrintersDlgs, Globals, BasicSPCUnit;
type type
@ -14,12 +14,24 @@ type
TCUSUMChartForm = class(TBasicSPCForm) TCUSUMChartForm = class(TBasicSPCForm)
AlphaEdit: TEdit; AlphaEdit: TEdit;
hEdit: TEdit;
BetaEdit: TEdit; BetaEdit: TEdit;
Bevel3: TBevel;
kEdit: TEdit;
TabularGroup: TGroupBox;
Label1: TLabel; Label1: TLabel;
Label7: TLabel;
Label8: TLabel;
Notebook: TNotebook;
TabularPage: TPage;
StdDevChk: TCheckBox;
StdDevEdit: TEdit;
VMaskPage: TPage;
rbTabular: TRadioButton;
rbVMask: TRadioButton;
VMaskScrollbar: TScrollBar; VMaskScrollbar: TScrollBar;
ShowMeanDevChk: TCheckBox;
DeltaEdit: TEdit; DeltaEdit: TEdit;
GroupBox1: TGroupBox; VMaskGroup: TGroupBox;
GroupBox2: TGroupBox; GroupBox2: TGroupBox;
Label4: TLabel; Label4: TLabel;
Label5: TLabel; Label5: TLabel;
@ -27,13 +39,15 @@ type
TargetChk: TCheckBox; TargetChk: TCheckBox;
TargetEdit: TEdit; TargetEdit: TEdit;
procedure FormActivate(Sender: TObject); procedure FormActivate(Sender: TObject);
procedure rbTabularChange(Sender: TObject);
private private
CUSums, CUSumsUpper, CUSumsLower: DblDyneVec;
SEMean: Double; SEMean: Double;
k, h: Double; k, h: Double;
protected protected
procedure Compute; override; procedure Compute; override;
procedure PlotMeans(ATitle, AXTitle, AYTitle, ADataTitle, AGrandMeanTitle: String; procedure PlotMeans(ATitle, AXTitle, AYTitle, ADataTitle, AGrandMeanTitle: String;
const Groups: StrDyneVec; const Means: DblDyneVec; const Groups: StrDyneVec; const {%H-}Means: DblDyneVec;
UCL, LCL, GrandMean, TargetSpec, LowerSpec, UpperSpec: double); override; UCL, LCL, GrandMean, TargetSpec, LowerSpec, UpperSpec: double); override;
procedure Reset; override; procedure Reset; override;
function Validate(out AMsg: String; out AControl: TWinControl): Boolean; override; function Validate(out AMsg: String; out AControl: TWinControl): Boolean; override;
@ -48,44 +62,53 @@ implementation
{$R *.lfm} {$R *.lfm}
uses uses
Math, TAChartUtils, TASeries, Math, TAChartUtils, TATypes, TASeries,
Utils, MainUnit, DataProcs; Utils, MainUnit, ChartFrameUnit, DataProcs;
{ TCUSUMChartForm } { TCUSUMChartForm }
procedure TCUSUMChartForm.Compute; procedure TCUSUMChartForm.Compute;
var var
i, j, grpIndex, numGrps, grpSize, oldGrpSize, numValues: Integer; i, j, grpIndex, numGrps, grpSize, oldGrpSize, numValues: Integer;
X, Xsq, Xmin, Xmax, target, diff, grandMean, grandSum, grandSD: Double; X, Xsq, prevX: Double;
deltaSD, alpha, beta: double; target, stdDev, diff, grandMean, grandSD, aveSD: Double;
sizeError: Boolean; delta, alpha, beta: double;
grp: String; grp: String;
individuals: Boolean;
UCL: Double = NaN;
LCL: Double = NaN;
groups: StrDyneVec = nil; groups: StrDyneVec = nil;
means: DblDyneVec = nil; means: DblDyneVec = nil;
stdDev: DblDyneVec = nil; stdDevs: DblDyneVec = nil;
cuSums: DblDyneVec = nil;
count: IntDyneVec = nil; count: IntDyneVec = nil;
ColNoSelected: IntDyneVec = nil; ColNoSelected: IntDyneVec = nil;
lReport: TStrings; lReport: TStrings;
begin
if GroupEdit.Text <> '' then
begin begin
SetLength(ColNoSelected, 2); SetLength(ColNoSelected, 2);
ColNoSelected[0] := GrpVar; ColNoSelected[0] := GrpVar;
ColNoSelected[1] := MeasVar; ColNoSelected[1] := MeasVar;
individuals := false;
groups := GetGroups;
end else
begin
SetLength(ColNoSelected, 1);
ColNoSelected[0] := MeasVar;
individuals := true;
SetLength(groups, NoCases)
end;
groups := GetGroups();
numGrps := Length(groups); numGrps := Length(groups);
grpSize := 0; grpSize := 0;
oldGrpSize := 0; oldGrpSize := 0;
SetLength(means, numGrps);
SetLength(count, numGrps); SetLength(count, numGrps);
SetLength(stdDev, numGrps); SetLength(means, numGrps);
SetLength(cuSums, numGrps); SetLength(stdDevs, numGrps);
SEMean := 0.0;
grandMean := 0.0; grandMean := 0.0;
grandSum := 0.0; grandSD := 0.0;
sizeError := false;
// Count "good" data points // Count "good" data points
numValues := 0; numValues := 0;
@ -93,10 +116,32 @@ begin
if GoodRecord(i, Length(ColNoSelected), ColNoSelected) then inc(numValues); if GoodRecord(i, Length(ColNoSelected), ColNoSelected) then inc(numValues);
// calculate group ranges, grand mean, group sd's, semeans // calculate group ranges, grand mean, group sd's, semeans
if individuals then
begin
// x-bar chart of individual measurements, no groups
grpIndex := 0;
prevX := NaN;
for i := 1 to NoCases do
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
stdDevs[grpIndex-1] := abs(X - prevX); // assume std dev to be moving range;
// -1 --> skip empty 1st value
grandMean := grandMean + X;
grandSD := grandSD + Xsq;
inc(grpIndex);
prevX := X;
end;
SetLength(stdDevs, numGrps - 1); // skip empty 1st value
end else
begin
for j := 0 to numGrps - 1 do // groups for j := 0 to numGrps - 1 do // groups
begin begin
Xmin := Infinity;
Xmax := -Infinity;
for i := 1 to NoCases do for i := 1 to NoCases do
begin begin
if not GoodRecord(i, Length(ColNoSelected), ColNoSelected) then continue; if not GoodRecord(i, Length(ColNoSelected), ColNoSelected) then continue;
@ -106,67 +151,102 @@ begin
begin begin
X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[MeasVar, i])); X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[MeasVar, i]));
Xsq := X * X; Xsq := X * X;
if X > Xmax then Xmax := X;
if X < Xmin then Xmin := X;
inc(count[grpIndex]); inc(count[grpIndex]);
means[grpIndex] := means[grpIndex] + X; means[grpIndex] := means[grpIndex] + X;
stddev[grpIndex] := stddev[grpIndex] + Xsq; stdDevs[grpIndex] := stdDevs[grpIndex] + Xsq;
SEMean := SEMean + Xsq;
grandMean := grandMean + X; grandMean := grandMean + X;
grandSD := grandSD + Xsq;
end; end;
end; // next case end; // next case
grpSize := count[j]; grpSize := count[j];
if j = 0 then oldgrpSize := grpSize; if j = 0 then oldgrpSize := grpSize;
if (oldGrpsize <> grpSize) or (grpSize < 2) then if (oldGrpSize <> grpSize) then
begin begin
sizeError := true; ErrorMsg('All groups must have the same size.');
break;
end;
stdDev[j] := stddev[j] - sqr(means[j]) / grpSize;
stddev[j] := stddev[j] / (grpSize - 1);
stddev[j] := sqrt(stddev[j]);
means[j] := means[j] / grpSize;
end; // next group
if (grpSize < 2) or (grpSize > 25) or sizeError then
begin
ErrorMsg('Group size error.');
exit; exit;
end; end;
// now get cumulative deviations of means from target stdDevs[j] := stdDevs[j] - sqr(means[j]) / grpSize;
stdDevs[j] := stdDevs[j] / (grpSize - 1);
stdDevs[j] := sqrt(stdDevs[j]);
means[j] := means[j] / grpSize;
end; // next group
end;
grandSD := grandSD - sqr(grandMean) / numValues;
grandSD := sqrt(grandSD / (numValues - 1));
SEMean := grandSD / sqrt(numValues);
grandMean := grandMean/numValues; // mean of all observations
if individuals then
begin
aveSD := 0;
for i := 0 to High(stdDevs) do
aveSD := aveSD + stdDevs[i];
aveSD := aveSD / Length(stdDevs) / 1.128; // 1.128 is the value of d2 fo n = 2.
end else
aveSD := grandSD / sqrt(grpSize);
if TargetChk.Checked then if TargetChk.Checked then
target := StrToFloat(TargetEdit.Text) target := StrToFloat(TargetEdit.Text)
else else
target := means[numGrps-1]; target := grandMean; //means[numGrps-1];
cusums[0] := means[0] - target;
grandSum := grandSum + (means[0] - target); if StdDevChk.Checked then
for j := 1 to numGrps-1 do stdDev := StrToFloat(StdDevEdit.Text)
else
stdDev := aveSD;
if rbTabular.Checked then
begin
k := StrToFloat(kEdit.Text) * stdDev;
h := StrToFloat(hEdit.Text) * stdDev;
UCL := h;
LCL := -h;
end else
begin begin
diff := means[j] - target;
cusums[j] := cusums[j-1] + diff;
grandSum := grandSum + diff;
end;
SEMean := SEMean - sqr(grandMean)/numValues;
SEMean := sqrt(SEMean/(numValues - 1));
grandSD := SEMean;
SEMean := SEMean/sqrt(numValues);
grandMean := grandMean/numValues; // mean of all observations
grandSum := grandSum/numGrps; // mean of the group means
if DeltaEdit.Text <> '' then if DeltaEdit.Text <> '' then
begin begin
deltaSD := StrToFloat(DeltaEdit.Text) / SEMean; delta := StrToFloat(DeltaEdit.Text) / stdDev;
// This is in multiples of std deviations // This is in multiples of std deviations
// see : https://www.itl.nist.gov/div898/handbook/pmc/section3/pmc323.htm // see : https://www.itl.nist.gov/div898/handbook/pmc/section3/pmc323.htm
alpha := StrToFloat(AlphaEdit.Text); alpha := StrToFloat(AlphaEdit.Text);
beta := StrToFloat(BetaEdit.Text); beta := StrToFloat(BetaEdit.Text);
k := deltaSD * SEMean / 2.0;
h := SEMean / deltaSD * ln((1 - beta) / alpha); k := stdDev * delta / 2.0;
h := stdDev / delta * ln((1-beta) / alpha);
end;
end;
// Now get cumulative deviations of means from target
diff := means[0] - target;
if rbVMask.Checked then
begin
SetLength(CUSums, numGrps);
FillChar(CUSums[0], numGrps*SizeOf(Double), 0);
CUSums[0] := diff;
end;
if rbTabular.Checked then
begin
SetLength(CUSumsUpper, numGrps);
FillChar(CUSumsUpper[0], numGrps*SizeOf(Double), 0);
CUSumsUpper[0] := 0; //Max(0, diff);
SetLength(CUSumsLower, numGrps);
FillChar(CUSumsLower[0], numGrps*SizeOf(Double), 0);
CUSumsLower[0] := 0; //Max(0, diff);
end;
for j := 1 to numGrps-1 do
begin
diff := means[j] - target;
if rbVMask.Checked then
CUSums[j] := CUSums[j-1] + diff;
if rbTabular.Checked then
begin
CUSumsUpper[j] := Max(0, diff - k + CUSumsUpper[j-1]);
CUSumsLower[j] := Min(0, diff + k + CUSumsLower[j-1]);
// wp: There's a lot of garbage in the internet on these formulas!
end;
end; end;
// Print results // Print results
@ -176,35 +256,55 @@ begin
lReport.Add ('CUSUM Chart Results'); lReport.Add ('CUSUM Chart Results');
lReport.Add (''); lReport.Add ('');
lReport.Add ('Number of Values: %8d', [numValues]); lReport.Add ('Number of Values: %8d', [numValues]);
lReport.Add('Mean of group deviations: %8.3f', [grandSum]); lReport.Add ('Number of groups: %8d', [numGrps]);
lReport.Add ('Group size: %8d', [grpSize]);
lReport.Add ('');
lReport.Add ('Mean of all observations: %8.3f', [grandMean]); lReport.Add ('Mean of all observations: %8.3f', [grandMean]);
lReport.Add('Std. Dev. of Observations: %8.3f', [grandSD]); lReport.Add ('Std. Dev. of observations: %8.3f', [grandSD]);
lReport.Add('Standard Error of Mean: %8.3f', [SEMean]); lReport.Add ('Standard error of Mean: %8.3f', [SEMean]);
lReport.Add('Target Specification: %8.3f', [target]); lReport.Add ('Target specification: %8.3f', [target]);
lReport.Add ('Average group std dev: %8.3f', [aveSD]);
lReport.Add('');
lReport.Add('Differences in data units');
lReport.Add (''); lReport.Add ('');
lReport.Add('Group Size Mean Std.Dev. Mean-Dev Cum.Dev. of' ); if rbTabular.Checked then
lReport.Add(' Mean from Target'); begin
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]);
lReport.Add ('');
lReport.Add ('Group Size Mean Mean Dev Cum. Deviation ' );
lReport.Add (' Upper Lower ');
lReport.Add ('----- ---- -------- -------- ---------------------');
for i := 0 to numGrps - 1 do for i := 0 to numGrps - 1 do
begin begin
lReport.Add('%5s %4d %8.3f %8.3f %8.3f %10.3f', [ lReport.Add('%5s %4d %8.3f %8.3f %9.3f %9.3f', [
groups[i], count[i], means[i], stddev[i], means[i]-target, cusums[i] groups[i], count[i], means[i], means[i]-target, CUSumsUpper[i], CUSumsLower[i]
]); ]);
end; end;
end;
if rbVMask.Checked then
begin
if DeltaEdit.Text <> '' then if DeltaEdit.Text <> '' then
begin begin
lReport.Add('');
lReport.Add('V-Mask parameters:'); lReport.Add('V-Mask parameters:');
lReport.Add(' Alpha (Type I error) %8.3f', [alpha]); lReport.Add(' Alpha (Type I error) %8.3f', [alpha]);
lReport.Add(' Beta (Type II error) %8.3f', [beta]); lReport.Add(' Beta (Type II error) %8.3f', [beta]);
lReport.Add(' k: %8.3f (%.2f sigma)', [k, k/SEMean]); lReport.Add(' k: %8.3f (%.2f sigma)', [k, k/SEMean]);
lReport.Add(' h: %8.3f (%.2f sigma)', [h, h/SEMean]); lReport.Add(' h: %8.3f (%.2f sigma)', [h, h/SEMean]);
end; end;
lReport.Add ('');
lReport.Add ('Group Size Mean Mean Dev Cum.Dev. of' );
lReport.Add (' Mean from Target');
lReport.Add ('----- ---- -------- -------- ----------------');
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]
]);
end;
end;
ReportMemo.Lines.Assign(lReport); ReportMemo.Lines.Assign(lReport);
finally finally
@ -213,16 +313,14 @@ begin
// Show graph // Show graph
VMaskScrollbar.Max := numGrps; VMaskScrollbar.Max := numGrps;
if not ShowMeanDevChk.Checked then
grandSum := NaN;
PlotMeans( PlotMeans(
Format('Cumulative Sum Chart for "%s"', [GetFileName]), // chart title Format('Cumulative Sum Chart for "%s"', [GetFileName]), // chart title
GroupEdit.Text, // x title GroupEdit.Text, // x title
'CUSUM of ' + MeasEdit.Text + ' differences', // y title 'CUSUM of ' + MeasEdit.Text + ' differences', // y title
'Data', // series title 'Data', // series title
'Mean', // mean label at right 'Mean', // mean label at right
groups, cuSums, groups, nil, // y values will be applied in overridden method
NaN, NaN, grandSum, UCL, LCL, NaN,
NaN, NaN, NaN NaN, NaN, NaN
); );
end; end;
@ -232,6 +330,8 @@ procedure TCUSUMChartForm.FormActivate(Sender: TObject);
var var
w: Integer; w: Integer;
begin begin
NoGroupsAllowed := true;
w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]);
HelpBtn.Constraints.MinWidth := w; HelpBtn.Constraints.MinWidth := w;
ResetBtn.Constraints.MinWidth := w; ResetBtn.Constraints.MinWidth := w;
@ -240,20 +340,36 @@ begin
DisableAutoSizing; DisableAutoSizing;
try try
GroupBox1.Anchors := GroupBox1.Anchors - [akRight]; // VMaskGroup.Anchors := VMaskGroup.Anchors - [akRight];
VarList.Constraints.MinWidth := VarListLabel.Width; VarList.Constraints.MinWidth := VarListLabel.Width;
SpecsPanel.Constraints.MinWidth := Max( SpecsPanel.Constraints.MinWidth := Max(
CloseBtn.Left + CloseBtn.Width - HelpBtn.Left + HelpBtn.BorderSpacing.Around, CloseBtn.Left + CloseBtn.Width - HelpBtn.Left + HelpBtn.BorderSpacing.Around,
GroupBox2.Width * 2 + VarList.BorderSpacing.Right + VarList.BorderSpacing.Left GroupBox2.Width * 2 + VarList.BorderSpacing.Right + VarList.BorderSpacing.Left
); );
Constraints.MinHeight := GroupBox1.Top + GroupBox1.Height + GroupBox1.BorderSpacing.Bottom + ButtonPanel.Height; TabularGroup.Constraints.MinHeight := VMaskScrollbar.Top + VMaskScrollbar.Height +
Height := 1; // enforce autosizing of height VMaskScrollbar.BorderSpacing.Bottom + TabularGroup.Height - TabularGroup.ClientHeight;
GroupBox1.Anchors := GroupBox1.Anchors + [akRight]; Notebook.Constraints.MinHeight := TabularGroup.Constraints.MinHeight;
Notebook.Height := 1; // Enforce notebook autosizing
Constraints.MinHeight := Notebook.Top + Notebook.Height + Notebook.BorderSpacing.Bottom + ButtonPanel.Height;
if Height < Constraints.MinHeight then
Height := 1; // enforce height autosizing
// VMaskGroup.Anchors := VMaskGroup.Anchors + [akRight];
finally finally
EnableAutoSizing; EnableAutoSizing;
end; end;
end; end;
procedure TCUSUMChartForm.rbTabularChange(Sender: TObject);
begin
if (Sender = rbTabular) and rbTabular.Checked then
Notebook.PageIndex := 0
else
if (Sender = rbVMask) and rbVMask.Checked then
Notebook.PageIndex := 1;
end;
{ Overridden to draw the V-Mark } { Overridden to draw the V-Mark }
procedure TCUSUMChartForm.PlotMeans(ATitle, AXTitle, AYTitle, ADataTitle, AGrandMeanTitle: String; procedure TCUSUMChartForm.PlotMeans(ATitle, AXTitle, AYTitle, ADataTitle, AGrandMeanTitle: String;
const Groups: StrDyneVec; const Means: DblDyneVec; const Groups: StrDyneVec; const Means: DblDyneVec;
@ -262,8 +378,23 @@ var
ser: TLineSeries; ser: TLineSeries;
xVM, yVM, x1, y1, x2, y2, x3, y3, x4, y4: Double; xVM, yVM, x1, y1, x2, y2, x3, y3, x4, y4: Double;
begin begin
inherited; // Tabular CUSUM Chart: Plot the lower CUSums in addition to the upper CUSums.
if DeltaEdit.Text = '' then if rbTabular.Checked then
begin
inherited PlotMeans(ATitle, AXTitle, AYTitle, 'Upper CUSums', AGrandMeanTitle,
Groups, CUSumsUpper, UCL, LCL, GrandMean, TargetSpec, LowerSpec, UpperSpec);
ser := TLineSeries(FChartFrame.PlotXY(ptLinesAndSymbols, nil, CUSUMsLower, Groups, nil, 'Lower CUSums', clBlack));
// ser.Pointer.Style := psDiamond;
ser.Pointer.Brush.Color := clWhite;
end;
// CUSUM Chart with V-Mask
if rbVMask.Checked then begin
inherited PlotMeans(ATitle, AXTitle, AYTitle, ADataTitle, AGrandMeanTitle,
Groups, CUSums, NaN, NaN, GrandMean, TargetSpec, LowerSpec, UpperSpec);
if (DeltaEdit.Text = '') then
exit; exit;
ser := TLineSeries.Create(FChartFrame.Chart); ser := TLineSeries.Create(FChartFrame.Chart);
@ -273,7 +404,7 @@ begin
// Position of V mask point // Position of V mask point
xVM := VMaskScrollbar.Position; xVM := VMaskScrollbar.Position;
yVM := Means[VMaskScrollbar.Position-1]; yVM := CUSums[VMaskScrollbar.Position-1];
// Upper part of V mask // Upper part of V mask
x2 := xVM; x2 := xVM;
@ -289,20 +420,23 @@ begin
ser.AddXY(x1, y1); ser.AddXY(x1, y1);
ser.AddXY(x2, y2); ser.AddXY(x2, y2);
ser.AddXY(x2, NaN); // Do not draw the vertical line // ser.AddXY(x2, NaN); // Do not draw the vertical line
ser.AddXY(x3, y3); ser.AddXY(x3, y3);
ser.AddXY(x4, y4); ser.AddXY(x4, y4);
end; end;
end;
procedure TCUSUMChartForm.Reset; procedure TCUSUMChartForm.Reset;
begin begin
inherited; inherited;
ShowMeanDevChk.Checked := false;
TargetEdit.Clear; TargetEdit.Clear;
StdDevEdit.Clear;
DeltaEdit.Clear; DeltaEdit.Clear;
AlphaEdit.Text := FormatFloat('0.00000', 0.0027); //DEFAULT_ALPHA_LEVEL); kEdit.Text := FormatFloat('0.0', 0.5);
BetaEdit.Text := FormatFloat('0.00000', 0.01); //DEFAULT_BETA_LEVEL); hEdit.Text := '4';
AlphaEdit.Text := FormatFloat('0.00', DEFAULT_ALPHA_LEVEL);
BetaEdit.Text := FormatFloat('0.00', DEFAULT_BETA_LEVEL);
VMaskScrollbar.Min := 2; VMaskScrollbar.Min := 2;
VMaskScrollbar.Max := 1000; VMaskScrollbar.Max := 1000;
VMaskScrollbar.Position := VMaskScrollbar.Max; VMaskScrollbar.Position := VMaskScrollbar.Max;
@ -312,15 +446,52 @@ end;
function TCUSUMChartForm.Validate(out AMsg: String; out AControl: TWinControl): Boolean; function TCUSUMChartForm.Validate(out AMsg: String; out AControl: TWinControl): Boolean;
var var
x: Double; x: Double;
n: Integer;
begin begin
Result := inherited; Result := inherited;
if not Result then if (not Result) then
begin
// This particular chart will handle individual data if GroupEdit is empty.
if GroupEdit.Visible and (GroupEdit.Text = '') then
Result := true
else
exit; exit;
end;
Result := false; Result := false;
if (DeltaEdit.Text <> '') then if TargetChk.Checked then
begin
if (TargetEdit.Text = '') then
begin
AMsg := 'Target not specified.';
AControl := TargetEdit;
exit;
end;
if not TryStrToFloat(TargetEdit.Text, x) then
begin
AMsg := 'No valid number given for target specification.';
AControl := TargetEdit;
exit;
end;
end;
if StdDevChk.Checked then
begin
if (StdDevEdit.Text = '') then
begin
AMsg := 'Standard deviation expected, but not specified.';
AControl := StdDevEdit;
exit;
end;
if not TryStrToFloat(StdDevEdit.Text, x) then
begin
AMsg := 'No valid number given for standard deviation.';
AControl := StdDevEdit;
exit;
end;
end;
if rbVMask.Checked and (DeltaEdit.Text <> '') then
begin begin
if not TryStrToFloat(DeltaEdit.Text, x) then if not TryStrToFloat(DeltaEdit.Text, x) then
begin begin
@ -356,18 +527,31 @@ begin
end; end;
end; end;
if TargetChk.Checked then if rbTabular.Checked then
begin begin
if (TargetEdit.Text = '') then if (kEdit.Text = '') then
begin begin
AMsg := 'Target not specified.'; AMsg := 'k not specified.';
AControl := TargetEdit; AControl := kEdit;
exit; exit;
end; end;
if not TryStrToFloat(TargetEdit.Text, x) then if not TryStrToFloat(kEdit.Text, x) then
begin begin
AMsg := 'No valid number given for target specification.'; AMsg := 'No valid number given for k.';
AControl := TargetEdit; AControl := kEdit;
exit;
end;
if (hEdit.Text = '') then
begin
AMsg := 'h not specified.';
AControl := hEdit;
exit;
end;
if not TryStrToFloat(hEdit.Text, x) then
begin
AMsg := 'No valid number given for h.';
AControl := hEdit;
exit; exit;
end; end;
end; end;

View File

@ -61,7 +61,7 @@ implementation
uses uses
Math, Math,
Utils, MainUnit, DataProcs; Utils, MathUnit, MainUnit, DataProcs;
{$R *.lfm} {$R *.lfm}
@ -118,6 +118,7 @@ var
grp: String; grp: String;
X, Xsq, prevX: Double; X, Xsq, prevX: Double;
sigma, UCL, LCL, grandMean, grandSD, SEMean: Double; sigma, UCL, LCL, grandMean, grandSD, SEMean: Double;
//C4Value: Double;
individualsChart: Boolean; individualsChart: Boolean;
lReport: TStrings; lReport: TStrings;
begin begin
@ -258,7 +259,8 @@ begin
means[i] := means[i] / count[i]; means[i] := means[i] / count[i];
end; end;
end; end;
FAveStdDev := sqrt(FAveStdDev / (numGrps * grpSize)); // C4Value := CalcC4(grpSize);
FAveStdDev := sqrt(FAveStdDev / (numGrps * grpSize)); // / C4Value;
UCL := grandMean + sigma * FAveStdDev; UCL := grandMean + sigma * FAveStdDev;
LCL := grandMean - sigma * FAveStdDev; LCL := grandMean - sigma * FAveStdDev;
@ -289,9 +291,9 @@ begin
lReport.Add('Group size: %8d', [grpSize]); lReport.Add('Group size: %8d', [grpSize]);
lReport.Add(''); lReport.Add('');
lReport.Add('Grand Mean: %8.3f', [grandMean]); lReport.Add('Grand Mean: %8.3f', [grandMean]);
lReport.Add('Standard Deviation: %8.3f', [grandSD]);
lReport.Add('Standard Error of Mean: %8.3f', [SEMean]); lReport.Add('Standard Error of Mean: %8.3f', [SEMean]);
lReport.Add('Average Std Deviation: %8.3f', [FAveStdDev]); lReport.Add('Grand Std Deviation: %8.3f', [grandSD]);
lReport.Add('Average Group Std Dev: %8.3f', [FAveStdDev]);
lReport.Add('Upper Control Limit: %8.3f', [UCL]); lReport.Add('Upper Control Limit: %8.3f', [UCL]);
lReport.Add('Lower Control Limit: %8.3f', [LCL]); lReport.Add('Lower Control Limit: %8.3f', [LCL]);
lReport.Add(''); lReport.Add('');