Files
wp_xxyyzz e1c5977e0d LazStats: Adding original source, part 6.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7885 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2020-11-16 11:16:49 +00:00

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.