You've already forked lazarus-ccr
410 lines
13 KiB
ObjectPascal
410 lines
13 KiB
ObjectPascal
|
unit XBarUnit;
|
||
|
|
|
||
|
|
{$mode objfpc}{$H+}
|
||
|
|
|
||
|
|
interface
|
||
|
|
|
||
|
|
uses
|
||
|
|
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
||
|
|
StdCtrls, ExtCtrls, MainUnit, Globals, contexthelpunit,
|
||
|
|
DataProcs, Math, OutPutUnit, Buttons, FunctionsLib, GraphLib, BlankFrmUnit;
|
||
|
|
|
||
|
|
type
|
||
|
|
|
||
|
|
{ TXBarFrm }
|
||
|
|
|
||
|
|
TXBarFrm = class(TForm)
|
||
|
|
HelpBtn: TButton;
|
||
|
|
ResetBtn: TButton;
|
||
|
|
CancelBtn: TButton;
|
||
|
|
ComputeBtn: TButton;
|
||
|
|
ReturnBtn: TButton;
|
||
|
|
UpSpecEdit: TEdit;
|
||
|
|
LowSpecEdit: TEdit;
|
||
|
|
TargetSpecEdit: TEdit;
|
||
|
|
UpSpecChk: TCheckBox;
|
||
|
|
LowSpecChk: TCheckBox;
|
||
|
|
TargetChk: TCheckBox;
|
||
|
|
GroupBox1: TGroupBox;
|
||
|
|
XSigmaEdit: TEdit;
|
||
|
|
GroupEdit: TEdit;
|
||
|
|
MeasEdit: TEdit;
|
||
|
|
Label1: TLabel;
|
||
|
|
Label2: TLabel;
|
||
|
|
Label3: TLabel;
|
||
|
|
SigmaOpts: TRadioGroup;
|
||
|
|
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 }
|
||
|
|
procedure PlotMeans(VAR means : DblDyneVec;
|
||
|
|
NoGrps : integer;
|
||
|
|
UCL, LCL, GrandMean : double;
|
||
|
|
TargetSpec, LowerSpec, UpperSpec : double;
|
||
|
|
Sender: TObject);
|
||
|
|
public
|
||
|
|
{ public declarations }
|
||
|
|
end;
|
||
|
|
|
||
|
|
var
|
||
|
|
XBarFrm: TXBarFrm;
|
||
|
|
|
||
|
|
implementation
|
||
|
|
|
||
|
|
{ TXBarFrm }
|
||
|
|
|
||
|
|
procedure TXBarFrm.ResetBtnClick(Sender: TObject);
|
||
|
|
VAR i : integer;
|
||
|
|
begin
|
||
|
|
VarList.Clear;
|
||
|
|
GroupEdit.Text := '';
|
||
|
|
MeasEdit.Text := '';
|
||
|
|
XSigmaEdit.Text := '';
|
||
|
|
UpSpecEdit.Text := '';
|
||
|
|
LowSpecEdit.Text := '';
|
||
|
|
TargetSpecEdit.Text := '';
|
||
|
|
UpSpecChk.Checked := false;
|
||
|
|
LowSpecChk.Checked := false;
|
||
|
|
TargetChk.Checked := false;
|
||
|
|
SigmaOpts.ItemIndex := 0;
|
||
|
|
for i := 1 to NoVariables do
|
||
|
|
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TXBarFrm.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 TXBarFrm.FormShow(Sender: TObject);
|
||
|
|
begin
|
||
|
|
ResetBtnClick(self);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TXBarFrm.HelpBtnClick(Sender: TObject);
|
||
|
|
begin
|
||
|
|
ContextHelpForm.HelpMessage((Sender as TButton).tag);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TXBarFrm.ComputeBtnClick(Sender: TObject);
|
||
|
|
var
|
||
|
|
i, GrpVar, MeasVar, mingrp, maxgrp, G, range : integer;
|
||
|
|
X, UCL, LCL, Sigma, UpperSpec, LowerSpec, TargetSpec : double;
|
||
|
|
GrandMean, GrandSD, semean : double;
|
||
|
|
means, stddev : DblDyneVec;
|
||
|
|
count : IntDyneVec;
|
||
|
|
cellstring, outline : string;
|
||
|
|
ColNoSelected : IntDyneVec;
|
||
|
|
NoSelected : integer;
|
||
|
|
begin
|
||
|
|
SetLength(ColNoSelected,NoVariables);
|
||
|
|
OutPutFrm.RichEdit.Clear;
|
||
|
|
GrpVar := 1;
|
||
|
|
MeasVar := 2;
|
||
|
|
Sigma := 3.0;
|
||
|
|
UpperSpec := 0.0;
|
||
|
|
LowerSpec := 0.0;
|
||
|
|
TargetSpec := 0.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;
|
||
|
|
ColNoSelected[0] := MeasVar;
|
||
|
|
ColNoSelected[1] := GrpVar;
|
||
|
|
NoSelected := 2;
|
||
|
|
|
||
|
|
if UpSpecEdit.Text <> '' then UpperSpec := StrToFloat(UpSpecEdit.Text);
|
||
|
|
if LowSpecEdit.Text <> '' then LowerSpec := StrToFloat(LowSpecEdit.Text);
|
||
|
|
if TargetSpecEdit.Text <> '' then TargetSpec := StrToFloat(TargetSpecEdit.Text);
|
||
|
|
if SigmaOpts.ItemIndex = 3 then
|
||
|
|
Sigma := StrToFloat(XSigmaEdit.Text);
|
||
|
|
if SigmaOpts.ItemIndex = 0 then Sigma := 3.0;
|
||
|
|
if SigmaOpts.ItemIndex = 1 then Sigma := 2.0;
|
||
|
|
if SigmaOpts.ItemIndex = 2 then Sigma := 1.0;
|
||
|
|
|
||
|
|
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);
|
||
|
|
|
||
|
|
for i := 0 to range-1 do
|
||
|
|
begin
|
||
|
|
count[i] := 0;
|
||
|
|
means[i] := 0.0;
|
||
|
|
stddev[i] := 0.0;
|
||
|
|
end;
|
||
|
|
semean := 0.0;
|
||
|
|
GrandMean := 0.0;
|
||
|
|
|
||
|
|
// calculate group means, grand mean, group sd's, semeans
|
||
|
|
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;
|
||
|
|
X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[MeasVar,i]));
|
||
|
|
means[G-1] := means[G-1] + X;
|
||
|
|
count[G-1] := count[G-1] + 1;
|
||
|
|
stddev[G-1] := stddev[G-1] + (X * X);
|
||
|
|
semean := semean + (X * X);
|
||
|
|
GrandMean := GrandMean + X;
|
||
|
|
end;
|
||
|
|
|
||
|
|
for i := 0 to range-1 do
|
||
|
|
begin
|
||
|
|
stddev[i] := stddev[i] -((means[i] * means[i]) / count[i]);
|
||
|
|
if count[i] > 1 then
|
||
|
|
begin
|
||
|
|
stddev[i] := stddev[i] / (count[i] - 1);
|
||
|
|
stddev[i] := sqrt(stddev[i]);
|
||
|
|
end
|
||
|
|
else stddev[i] := 0.0;
|
||
|
|
means[i] := means[i] / count[i];
|
||
|
|
end;
|
||
|
|
semean := semean - ((GrandMean * GrandMean) / NoCases);
|
||
|
|
semean := semean / (NoCases - 1);
|
||
|
|
semean := sqrt(semean);
|
||
|
|
GrandSD := semean;
|
||
|
|
semean := semean / sqrt(NoCases);
|
||
|
|
GrandMean := GrandMean / NoCases;
|
||
|
|
UCL := GrandMean + (Sigma * semean);
|
||
|
|
LCL := GrandMean - (Sigma * semean);
|
||
|
|
|
||
|
|
// printed results
|
||
|
|
OutPutFrm.RichEdit.Lines.Add('X Bar Chart Results');
|
||
|
|
OutPutFrm.RichEdit.Lines.Add('');
|
||
|
|
OutPutFrm.RichEdit.Lines.Add('Group Size Mean Std.Dev.');
|
||
|
|
OutPutFrm.RichEdit.Lines.Add('_____ ____ _________ __________');
|
||
|
|
for i := 0 to range-1 do
|
||
|
|
begin
|
||
|
|
outline := format(' %3d %3d %8.2f %8.2f',
|
||
|
|
[i+1,count[i],means[i],stddev[i]]);
|
||
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
||
|
|
end;
|
||
|
|
outline := format('Grand Mean = %8.2f, Std.Dev. = %8.3f, Standard Error of Mean = %8.2f',
|
||
|
|
[GrandMean, GrandSD, semean]);
|
||
|
|
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
|
||
|
|
BlankFrm.Show;
|
||
|
|
PlotMeans(means,range,UCL,LCL,GrandMean,TargetSpec,
|
||
|
|
LowerSpec, UpperSpec, self);
|
||
|
|
|
||
|
|
stddev := nil;
|
||
|
|
count := nil;
|
||
|
|
means := nil;
|
||
|
|
ColNoSelected := nil;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TXBarFrm.PlotMeans(var means: DblDyneVec; NoGrps: integer; UCL, LCL,
|
||
|
|
GrandMean: double; TargetSpec, LowerSpec, UpperSpec: double; Sender: TObject
|
||
|
|
);
|
||
|
|
var
|
||
|
|
i, xpos, ypos, hleft, hright, vtop, vbottom, imagewide : integer;
|
||
|
|
vhi, hwide, offset, strhi : integer;
|
||
|
|
imagehi, maxval, minval, valincr, Yvalue : 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;
|
||
|
|
if UCL > maxval then maxval := UCL;
|
||
|
|
if LCL < minval then minval := LCL;
|
||
|
|
if UpSpecChk.Checked then
|
||
|
|
begin
|
||
|
|
if UpperSpec > maxval then maxval := UpperSpec;
|
||
|
|
end;
|
||
|
|
if LowSpecChk.Checked then
|
||
|
|
begin
|
||
|
|
if LowerSpec < minval then minval := LowerSpec;
|
||
|
|
end;
|
||
|
|
if TargetChk.Checked then
|
||
|
|
begin
|
||
|
|
if TargetSpec > maxval then maxval := TargetSpec;
|
||
|
|
if TargetSpec < minval then minval := TargetSpec;
|
||
|
|
end;
|
||
|
|
BlankFrm.Image1.Canvas.Clear;
|
||
|
|
// BlankFrm.Show;
|
||
|
|
Title := 'XBAR 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.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 := 'MEAN';
|
||
|
|
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 upper and lower confidence intervals
|
||
|
|
ypos := round(vhi * ( (maxval - UCL) / (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 := 'UCL';
|
||
|
|
strhi := BlankFrm.Image1.Canvas.TextHeight(Title);
|
||
|
|
ypos := ypos - strhi div 2;
|
||
|
|
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title);
|
||
|
|
|
||
|
|
ypos := round(vhi * ( (maxval - LCL) / (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 := 'LCL';
|
||
|
|
strhi := BlankFrm.Image1.Canvas.TextHeight(Title);
|
||
|
|
ypos := ypos - strhi div 2;
|
||
|
|
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title);
|
||
|
|
|
||
|
|
// Draw lines for specified values
|
||
|
|
if UpSpecChk.Checked then
|
||
|
|
begin
|
||
|
|
ypos := round(vhi * ( (maxval - UpperSpec) / (maxval - minval)));
|
||
|
|
ypos := ypos + vtop;
|
||
|
|
xpos := hleft;
|
||
|
|
BlankFrm.Image1.Canvas.MoveTo(xpos,ypos);
|
||
|
|
xpos := hright;
|
||
|
|
BlankFrm.Image1.Canvas.Pen.Color := clGreen;
|
||
|
|
BlankFrm.Image1.Canvas.LineTo(xpos,ypos);
|
||
|
|
Title := 'UPPER SPEC';
|
||
|
|
strhi := BlankFrm.Image1.Canvas.TextHeight(Title);
|
||
|
|
ypos := ypos - strhi div 2;
|
||
|
|
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title);
|
||
|
|
end;
|
||
|
|
|
||
|
|
if LowSpecChk.Checked then
|
||
|
|
begin
|
||
|
|
ypos := round(vhi * ( (maxval - LowerSpec) / (maxval - minval)));
|
||
|
|
ypos := ypos + vtop;
|
||
|
|
xpos := hleft;
|
||
|
|
BlankFrm.Image1.Canvas.MoveTo(xpos,ypos);
|
||
|
|
xpos := hright;
|
||
|
|
BlankFrm.Image1.Canvas.Pen.Color := clGreen;
|
||
|
|
BlankFrm.Image1.Canvas.LineTo(xpos,ypos);
|
||
|
|
Title := 'LOWER SPEC';
|
||
|
|
strhi := BlankFrm.Image1.Canvas.TextHeight(Title);
|
||
|
|
ypos := ypos - strhi div 2;
|
||
|
|
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title);
|
||
|
|
end;
|
||
|
|
|
||
|
|
if TargetChk.Checked then
|
||
|
|
begin
|
||
|
|
ypos := round(vhi * ( (maxval - TargetSpec) / (maxval - minval)));
|
||
|
|
ypos := ypos + vtop;
|
||
|
|
xpos := hleft;
|
||
|
|
BlankFrm.Image1.Canvas.MoveTo(xpos,ypos);
|
||
|
|
xpos := hright;
|
||
|
|
BlankFrm.Image1.Canvas.Pen.Color := clBlue;
|
||
|
|
BlankFrm.Image1.Canvas.LineTo(xpos,ypos);
|
||
|
|
Title := 'TARGET';
|
||
|
|
strhi := BlankFrm.Image1.Canvas.TextHeight(Title);
|
||
|
|
ypos := ypos - strhi div 2;
|
||
|
|
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
initialization
|
||
|
|
{$I xbarunit.lrs}
|
||
|
|
|
||
|
|
end.
|
||
|
|
|