unit CUMSUMUNIT; {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, MainUnit, Globals, DataProcs, OutPutUnit, Buttons, math, FunctionsLib, BlankFrmUnit, contexthelpunit; type { TCUMSUMFrm } TCUMSUMFrm = class(TForm) HelpBtn: TButton; TargetEdit: TEdit; TargetChk: TCheckBox; DeltaEdit: TEdit; AlphaEdit: TEdit; BetaEdit: TEdit; GroupBox1: TGroupBox; GroupBox2: TGroupBox; Label4: TLabel; Label5: TLabel; Label6: TLabel; ResetBtn: TButton; CancelBtn: TButton; ComputeBtn: TButton; ReturnBtn: TButton; MeasEdit: TEdit; GroupEdit: TEdit; Label1: TLabel; Label2: TLabel; Label3: TLabel; VarList: TListBox; procedure ComputeBtnClick(Sender: TObject); procedure FormShow(Sender: TObject); procedure HelpBtnClick(Sender: TObject); procedure ResetBtnClick(Sender: TObject); procedure VarListClick(Sender: TObject); private { private declarations } semean : double; procedure PlotMeans(VAR means : DblDyneVec; NoGrps : integer; GrandMean : double; Sender: TObject); public { public declarations } end; var CUMSUMFrm: TCUMSUMFrm; implementation { TCUMSUMFrm } procedure TCUMSUMFrm.ResetBtnClick(Sender: TObject); VAR i : integer; begin VarList.Clear; GroupEdit.Text := ''; MeasEdit.Text := ''; DeltaEdit.Text := ''; AlphaEdit.Text := '0.05'; BetaEdit.Text := '0.20'; TargetEdit.Text := ''; TargetChk.Checked := false; for i := 1 to NoVariables do VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); end; procedure TCUMSUMFrm.VarListClick(Sender: TObject); VAR index : integer; begin index := VarList.ItemIndex; if GroupEdit.Text = '' then GroupEdit.Text := VarList.Items.Strings[index] else MeasEdit.Text := VarList.Items.Strings[index]; end; procedure TCUMSUMFrm.FormShow(Sender: TObject); begin ResetBtnClick(self); end; procedure TCUMSUMFrm.HelpBtnClick(Sender: TObject); begin ContextHelpForm.HelpMessage((Sender as TButton).tag); end; procedure TCUMSUMFrm.ComputeBtnClick(Sender: TObject); label cleanup; var i, j, GrpVar, MeasVar, mingrp, maxgrp, G, range, grpsize : integer; oldgrpsize : integer; X, UCL, LCL : double; xmin, xmax, GrandMean, GrandSD : double; Target, GrandSum : double; means, stddev, cumsums : DblDyneVec; count : IntDyneVec; cellstring, outline : string; sizeerror : boolean; ColNoSelected : IntDyneVec; NoSelected : integer; begin SetLength(ColNoSelected,NoVariables); GrpVar := 1; MeasVar := 2; grpsize := 0; oldgrpsize := 0; for i := 1 to NoVariables do begin cellstring := OS3MainFrm.DataGrid.Cells[i,0]; if cellstring = GroupEdit.Text then GrpVar := i; if cellstring = MeasEdit.Text then MeasVar := i; end; NoSelected := 2; ColNoSelected[0] := GrpVar; ColNoSelected[1] := MeasVar; mingrp := 10000; maxgrp := -10000; for i := 1 to NoCases do begin if not GoodRecord(i,NoSelected,ColNoSelected) then continue; G := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[GrpVar,i]))); if G < mingrp then mingrp := G; if G > maxgrp then maxgrp := G; end; range := maxgrp - mingrp + 1; SetLength(means,range); SetLength(count,range); SetLength(stddev,range); SetLength(cumsums,range); for i := 0 to range-1 do begin count[i] := 0; means[i] := 0.0; stddev[i] := 0.0; cumsums[i] := 0.0; end; semean := 0.0; GrandMean := 0.0; sizeerror := false; GrandSum := 0.0; if TargetChk.Checked then Target := StrToFloat(TargetEdit.Text) else Target := 0.0; // calculate group ranges, grand mean, group sd's, semeans for j := 1 to range do // groups begin xmin := 10000.0; xmax := -10000.0; for i := 1 to NoCases do begin if not GoodRecord(i,NoSelected,ColNoSelected) then continue; G := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[GrpVar,i]))); G := G - mingrp + 1; if G = j then begin X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[MeasVar,i])); if X > xmax then xmax := X; if X < xmin then xmin := X; count[G-1] := count[G-1] + 1; stddev[G-1] := stddev[G-1] + (X * X); semean := semean + (X * X); means[G-1] := means[G-1] + X; GrandMean := GrandMean + X; end; end; // next case stddev[j-1] := stddev[j-1] - (means[j-1] * means[j-1] / count[j-1]); stddev[j-1] := stddev[j-1] / (count[j-1] - 1); stddev[j-1] := sqrt(stddev[j-1]); grpsize := count[j-1]; means[j-1] := means[j-1] / count[j-1]; if j = 1 then oldgrpsize := grpsize; if oldgrpsize <> grpsize then sizeerror := true; end; // next group // now get cumulative deviations of means from target if Target = 0.0 then Target := means[range-1]; cumsums[0] := means[0] - Target; GrandSum := GrandSum + (means[0] - Target); for j := 2 to range do begin cumsums[j-1] := cumsums[j-2] + (means[j-1] - Target); GrandSum := GrandSum + (means[j-1] - Target); end; if (grpsize < 2) or (grpsize > 25) or (sizeerror) then begin ShowMessage('ERROR! Group sizes error.'); goto cleanup; end; semean := semean - ((GrandMean * GrandMean) / NoCases); semean := semean / (NoCases - 1); semean := sqrt(semean); GrandSD := semean; semean := semean / sqrt(NoCases); GrandMean := GrandMean / NoCases; // mean of all observations GrandSum := GrandSum / range; // mean of the group means UCL := GrandMean + (3.0 * semean); LCL := GrandMean - (3.0 * semean); if (LCL < 0.0) then LCL := 0.0; // printed results OutPutFrm.RichEdit.Clear; OutPutFrm.RichEdit.Lines.Add('CUMSUM Chart Results'); OutPutFrm.RichEdit.Lines.Add(''); OutPutFrm.RichEdit.Lines.Add('Group Size Mean Std.Dev. Cum.Dev. of'); OutPutFrm.RichEdit.Lines.Add(' mean from Target'); OutPutFrm.RichEdit.Lines.Add('_____ ____ ________ ________ ___________'); for i := 0 to range-1 do begin outline := format(' %3d %3d %8.2f %8.2f %8.2f', [i+1,count[i], means[i], stddev[i], cumsums[i]]); OutPutFrm.RichEdit.Lines.Add(outline); end; outline := format('Mean of group deviations = %6.3f',[GrandSum]); OutPutFrm.RichEdit.Lines.Add(outline); outline := format('Mean of all observations = %6.3f',[GrandMean]); OutPutFrm.RichEdit.Lines.Add(outline); outline := format('Std. Dev. of Observations = %8.3f',[GrandSD]); OutPutFrm.RichEdit.Lines.Add(outline); outline := format('Standard Error of Mean = %8.3f',[semean]); OutPutFrm.RichEdit.Lines.Add(outline); outline := format('Target Specification = %6.3f',[Target]); OutPutFrm.RichEdit.Lines.Add(outline); outline := format('Lower Control Limit = %8.3f, Upper Control Limit = %8.3f', [LCL, UCL]); OutPutfrm.RichEdit.Lines.Add(outline); OutPutFrm.ShowModal; // show graph PlotMeans(cumsums,range,GrandSum,self); cleanup: cumsums := nil; stddev := nil; count := nil; means := nil; ColNoSelected := nil; end; procedure TCUMSUMFrm.PlotMeans(var means: DblDyneVec; NoGrps: integer; GrandMean: double; Sender: TObject); var i, xpos, ypos, hleft, hright, vtop, vbottom, imagewide : integer; vhi, hwide, offset, strhi, grpnospc, distx : integer; imagehi, maxval, minval, valincr, Yvalue : double; alpha, beta, delta, gamma, theta, kfactor, d : double; Title : string; begin maxval := -10000.0; minval := 10000.0; for i := 0 to NoGrps-1 do begin if means[i] > maxval then maxval := means[i]; if means[i] < minval then minval := means[i]; end; BlankFrm.Image1.Canvas.Clear; BlankFrm.Show; Title := 'CUMSUM CHART FOR : ' + OS3MainFrm.FileNameEdit.Text; BlankFrm.Caption := Title; imagewide := BlankFrm.Image1.Width; imagehi := BlankFrm.Image1.Height; vtop := 20; vbottom := round(imagehi) - 80; vhi := vbottom - vtop; hleft := 100; hright := imagewide - 80; hwide := hright - hleft; BlankFrm.Image1.Canvas.Pen.Color := clBlack; BlankFrm.Image1.Canvas.Brush.Color := clWhite; // Draw chart border BlankFrm.Image1.Canvas.Rectangle(hleft,vtop-10,hleft+hwide,vtop+vhi+10); // draw Grand Mean ypos := round(vhi * ( (maxval - GrandMean) / (maxval - minval))); ypos := ypos + vtop; xpos := hleft; BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); xpos := hright; BlankFrm.Image1.Canvas.Pen.Color := clRed; BlankFrm.Image1.Canvas.LineTo(xpos,ypos); Title := 'AVG.DEV.'; strhi := BlankFrm.Image1.Canvas.TextHeight(Title); ypos := ypos - strhi div 2; BlankFrm.Image1.Canvas.Brush.Color := clLtGray; BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); // draw horizontal axis BlankFrm.Image1.Canvas.MoveTo(hleft,vbottom + 20); BlankFrm.Image1.Canvas.LineTo(hright,vbottom + 20); for i := 1 to NoGrps do begin ypos := vbottom + 10; xpos := round((hwide / NoGrps)* i + hleft); BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); ypos := ypos + 10; BlankFrm.Image1.Canvas.LineTo(xpos,ypos); Title := format('%d',[i]); offset := BlankFrm.Image1.Canvas.TextWidth(Title) div 2; strhi := BlankFrm.Image1.Canvas.TextHeight(Title); xpos := xpos - offset; ypos := ypos + strhi; BlankFrm.Image1.Canvas.Pen.Color := clBlack; BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); xpos := 10; BlankFrm.Image1.Canvas.TextOut(xpos,ypos,'GROUPS:'); end; // Draw vertical axis valincr := (maxval - minval) / 10.0; for i := 1 to 11 do begin Title := format('%8.2f',[maxval - ((i-1)*valincr)]); strhi := BlankFrm.Image1.Canvas.TextHeight(Title); xpos := 10; Yvalue := maxval - (valincr * (i-1)); ypos := round(vhi * ( (maxval - Yvalue) / (maxval - minval))); ypos := ypos + vtop - strhi div 2; BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); end; // draw lines for means of the groups ypos := round(vhi * ( (maxval - means[0]) / (maxval - minval))); ypos := ypos + vtop; xpos := round((hwide / NoGrps) + hleft); BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); BlankFrm.Image1.Canvas.Pen.Color := clBlack; for i := 2 to NoGrps do begin ypos := round(vhi * ( (maxval - means[i-1]) / (maxval - minval))); ypos := ypos + vtop; xpos := round((hwide / NoGrps)* i + hleft); BlankFrm.Image1.Canvas.LineTo(xpos,ypos); end; // Draw V Mask if CumsumFrm.DeltaEdit.Text = '' then exit; // not elected BlankFrm.Image1.Canvas.Pen.Color := clBlue; delta := StrToFloat(CumsumFrm.DeltaEdit.Text); gamma := delta / semean; alpha := StrToFloat(CumSumFrm.AlphaEdit.Text); beta := StrToFloat(CumSumFrm.BetaEdit.Text); kfactor := 2.0 * semean; d := (2.0 / (gamma * gamma)) * ln((1.0 - beta)/alpha); theta := arctan(delta / (2.0 * kfactor)); grpnospc := round(hwide / NoGrps); xpos := hleft + (grpnospc * (NoGrps)); // last group ypos := round(vhi * ( (maxval - means[NoGrps-1]) / (maxval - minval))); ypos := ypos + vtop; BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); xpos := round(xpos + (d * grpnospc / hwide)); // scaled d BlankFrm.Image1.Canvas.LineTo(xpos,ypos); // line 0 to A // draw upper angle line xpos := hleft + (grpnospc * NoGrps); // last group xpos := round(xpos + (d * grpnospc / hwide)); // plus scaled d ypos := round(vhi * ( (maxval - means[NoGrps-1]) / (maxval - minval))); ypos := ypos + vtop; BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); ypos := vtop; // draw angle up to top of graph distx := round(vhi / tan(theta)); // x unscaled distance xpos := round(xpos - (distx * grpnospc / hwide)); BlankFrm.Image1.Canvas.LineTo(xpos,ypos); // draw lower angle line xpos := hleft + (grpnospc * NoGrps); // last group xpos := round(xpos + (d * grpnospc / hwide)); // plus scaled d ypos := round(vhi * ( (maxval - means[NoGrps-1]) / (maxval - minval))); ypos := ypos + vtop; BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); ypos := vbottom; xpos := round(xpos - (distx * grpnospc / hwide)); BlankFrm.Image1.Canvas.LineTo(xpos,ypos); BlankFrm.Image1.Canvas.Pen.Color := clBlack; end; initialization {$I cumsumunit.lrs} end.