You've already forked lazarus-ccr
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7885 8e941d3f-bd1b-0410-a28a-d453659cc2b4
292 lines
9.0 KiB
ObjectPascal
292 lines
9.0 KiB
ObjectPascal
unit PCHARTUnit;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
|
StdCtrls, ExtCtrls, MainUnit, Globals, Math, OutPutUnit, Buttons, DataProcs,
|
|
FunctionsLib, BlankFrmUnit, contexthelpunit;
|
|
|
|
type
|
|
|
|
{ TpChartFrm }
|
|
|
|
TpChartFrm = class(TForm)
|
|
HelpBtn: TButton;
|
|
XSigmaEdit: TEdit;
|
|
ResetBtn: TButton;
|
|
CancelBtn: TButton;
|
|
ComputeBtn: TButton;
|
|
Return: TButton;
|
|
NEdit: TEdit;
|
|
PEdit: TEdit;
|
|
Label3: TLabel;
|
|
Label4: TLabel;
|
|
MeasEdit: TEdit;
|
|
Label1: TLabel;
|
|
Label2: 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, Target : double;
|
|
Sender: TObject);
|
|
public
|
|
{ public declarations }
|
|
end;
|
|
|
|
var
|
|
pChartFrm: TpChartFrm;
|
|
|
|
implementation
|
|
|
|
{ TpChartFrm }
|
|
|
|
procedure TpChartFrm.ResetBtnClick(Sender: TObject);
|
|
VAR i : integer;
|
|
begin
|
|
VarList.Clear;
|
|
MeasEdit.Text := '';
|
|
NEdit.Text := '';
|
|
PEdit.Text := '';
|
|
XSigmaEdit.Text := '';
|
|
SigmaOpts.ItemIndex := 0;
|
|
for i := 1 to NoVariables do
|
|
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
|
|
end;
|
|
|
|
procedure TpChartFrm.VarListClick(Sender: TObject);
|
|
VAR index : integer;
|
|
begin
|
|
index := VarList.ItemIndex;
|
|
MeasEdit.Text := VarList.Items.Strings[index];
|
|
end;
|
|
|
|
procedure TpChartFrm.FormShow(Sender: TObject);
|
|
begin
|
|
ResetBtnClick(self);
|
|
end;
|
|
|
|
procedure TpChartFrm.HelpBtnClick(Sender: TObject);
|
|
begin
|
|
ContextHelpForm.HelpMessage((Sender as TButton).tag);
|
|
end;
|
|
|
|
procedure TpChartFrm.ComputeBtnClick(Sender: TObject);
|
|
var
|
|
P, N, variance, stddev, UCL, LCL, X, Sigma : double;
|
|
AVG : double;
|
|
i, measvar : integer;
|
|
cellstring, outline : string;
|
|
Obsp : DblDyneVec;
|
|
begin
|
|
AVG := 0.0;
|
|
measvar := 1;
|
|
Sigma := 3;
|
|
N := StrToFloat(NEdit.Text);
|
|
P := StrToFloat(PEdit.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;
|
|
for i := 1 to NoVariables do
|
|
begin
|
|
cellstring := OS3MainFrm.DataGrid.Cells[i,0];
|
|
if cellstring = MeasEdit.Text then measvar := i;
|
|
end;
|
|
variance := P * (1.0 - P) / N;
|
|
stddev := sqrt(variance);
|
|
SetLength(obsp,NoCases + 1);
|
|
for i := 1 to NoCases do
|
|
begin
|
|
X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[measvar,i]));
|
|
X := X / N;
|
|
obsp[i] := X;
|
|
AVG := AVG + X;
|
|
end;
|
|
AVG := AVG / NoCases;
|
|
UCL := P + Sigma * stddev;
|
|
LCL := P - Sigma * stddev;
|
|
|
|
// output results
|
|
OutPutFrm.RichEdit.Lines.Add('Defects p Control Chart Results');
|
|
OutPutFrm.RichEdit.Lines.Add('');
|
|
OutPutFrm.RichEdit.Lines.Add('Sample No. Proportion');
|
|
OutPutFrm.RichEdit.Lines.Add('__________ __________');
|
|
for i := 1 to NoCases do
|
|
begin
|
|
outline := format(' %5d %6.3f',[i,obsp[i]]);
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
|
end;
|
|
OutPutFrm.RichEdit.Lines.Add('');
|
|
outline := format('Target proportion = %6.4f',[P]);
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
|
outline := format('Sample size for each observation = %6.0f',[N]);
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
|
outline := format('Average proportion observed = %6.4f',[AVG]);
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
|
OutPutFrm.ShowModal;
|
|
|
|
// Now create plot
|
|
PlotMeans(obsp,NoCases,UCL,LCL, Avg, P,self);
|
|
obsp := nil;
|
|
end;
|
|
|
|
procedure TpChartFrm.PlotMeans(var means: DblDyneVec; NoGrps: integer; UCL,
|
|
LCL, GrandMean, Target: double; Sender: TObject);
|
|
var
|
|
i, xpos, ypos, hleft, hright, vtop, vbottom, imagewide : integer;
|
|
vhi, hwide, offset, strhi, oldxpos : integer;
|
|
imagehi, maxval, minval, valincr, Yvalue : double;
|
|
Title : string;
|
|
begin
|
|
maxval := -10000.0;
|
|
minval := 10000.0;
|
|
for i := 1 to NoGrps 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;
|
|
BlankFrm.Image1.Canvas.Clear;
|
|
BlankFrm.Show;
|
|
Title := 'p CONTROL 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 := clBlue;
|
|
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 target
|
|
ypos := round(vhi * ( (maxval - Target) / (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 := 'TARGET';
|
|
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);
|
|
oldxpos := 0;
|
|
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;
|
|
if xpos > oldxpos then
|
|
begin
|
|
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title);
|
|
oldxpos := xpos + (offset * 2);
|
|
end;
|
|
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[1]) / (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]) / (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);
|
|
end;
|
|
|
|
initialization
|
|
{$I pchartunit.lrs}
|
|
|
|
end.
|
|
|