LazStats: Refactor PCurvesUnit. Add pdf help to chm.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7403 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-04-25 16:16:11 +00:00
parent 1151b80f90
commit 71fb8c7899
4 changed files with 311 additions and 238 deletions

View File

@ -1,13 +1,14 @@
object PCurvesFrm: TPCurvesFrm
Left = 446
Height = 215
Height = 240
Top = 161
Width = 380
Width = 280
AutoSize = True
BorderStyle = bsDialog
Caption = 'Power Analysis for a z Test'
ClientHeight = 215
ClientWidth = 380
ClientHeight = 240
ClientWidth = 280
OnActivate = FormActivate
OnCreate = FormCreate
OnShow = FormShow
Position = poMainFormCenter
@ -30,7 +31,7 @@ object PCurvesFrm: TPCurvesFrm
AnchorSideTop.Side = asrCenter
Left = 12
Height = 15
Top = 43
Top = 39
Width = 199
BorderSpacing.Left = 12
Caption = 'Standard Deviation of the Distribution'
@ -42,7 +43,7 @@ object PCurvesFrm: TPCurvesFrm
AnchorSideTop.Side = asrCenter
Left = 12
Height = 15
Top = 74
Top = 66
Width = 62
BorderSpacing.Left = 12
Caption = 'Sample Size'
@ -57,6 +58,7 @@ object PCurvesFrm: TPCurvesFrm
Width = 53
Alignment = taRightJustify
BorderSpacing.Top = 8
BorderSpacing.Right = 12
TabOrder = 0
Text = 'NullEdit'
end
@ -67,13 +69,13 @@ object PCurvesFrm: TPCurvesFrm
AnchorSideTop.Side = asrBottom
Left = 219
Height = 23
Top = 39
Top = 35
Width = 53
Alignment = taRightJustify
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Top = 4
TabOrder = 1
Text = 'Edit1'
Text = 'SDEdit'
end
object NEdit: TEdit
AnchorSideLeft.Control = SDEdit
@ -81,12 +83,12 @@ object PCurvesFrm: TPCurvesFrm
AnchorSideTop.Side = asrBottom
Left = 219
Height = 23
Top = 70
Top = 62
Width = 53
Alignment = taRightJustify
BorderSpacing.Top = 8
BorderSpacing.Top = 4
TabOrder = 2
Text = 'Edit1'
Text = 'NEdit'
end
object GroupBox1: TGroupBox
AnchorSideLeft.Control = Owner
@ -96,13 +98,13 @@ object PCurvesFrm: TPCurvesFrm
AnchorSideRight.Side = asrBottom
Left = 12
Height = 82
Top = 109
Top = 101
Width = 260
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BorderSpacing.Left = 12
BorderSpacing.Top = 16
BorderSpacing.Bottom = 12
BorderSpacing.Bottom = 8
Caption = 'Probability of a Type I Error:'
ChildSizing.TopBottomSpacing = 8
ChildSizing.VerticalSpacing = 8
@ -163,88 +165,71 @@ object PCurvesFrm: TPCurvesFrm
TabOrder = 5
end
end
object Panel1: TPanel
AnchorSideLeft.Control = NullEdit
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Owner
AnchorSideBottom.Control = GroupBox1
object CloseBtn: TButton
AnchorSideTop.Control = Bevel1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Side = asrBottom
Left = 288
Height = 191
Top = 0
Width = 76
Anchors = [akTop, akLeft, akBottom]
Left = 217
Height = 25
Top = 207
Width = 55
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Left = 16
BorderSpacing.Right = 12
BevelOuter = bvNone
ChildSizing.ControlsPerLine = 1
ClientHeight = 191
ClientWidth = 76
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Close'
ModalResult = 11
TabOrder = 6
end
object ComputeBtn: TButton
AnchorSideTop.Control = CloseBtn
AnchorSideRight.Control = CloseBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 133
Height = 25
Top = 207
Width = 76
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Compute'
OnClick = ComputeBtnClick
TabOrder = 5
end
object ResetBtn: TButton
AnchorSideTop.Control = CloseBtn
AnchorSideRight.Control = ComputeBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 71
Height = 25
Top = 207
Width = 54
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Bottom = 8
Caption = 'Reset'
OnClick = ResetBtnClick
TabOrder = 4
object ResetBtn: TButton
AnchorSideLeft.Control = Panel1
AnchorSideRight.Control = Panel1
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = CancelBtn
Left = 0
Height = 25
Top = 55
Width = 76
Anchors = [akLeft, akRight, akBottom]
AutoSize = True
BorderSpacing.Bottom = 12
Caption = 'Reset'
OnClick = ResetBtnClick
TabOrder = 0
end
object CancelBtn: TButton
AnchorSideLeft.Control = Panel1
AnchorSideRight.Control = Panel1
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = ComputeBtn
Left = 0
Height = 25
Top = 92
Width = 76
Anchors = [akLeft, akRight, akBottom]
AutoSize = True
BorderSpacing.Bottom = 12
Caption = 'Cancel'
ModalResult = 2
TabOrder = 1
end
object ComputeBtn: TButton
AnchorSideLeft.Control = Panel1
AnchorSideRight.Control = Panel1
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = ReturnBtn
Left = 0
Height = 25
Top = 129
Width = 76
Anchors = [akLeft, akRight, akBottom]
AutoSize = True
BorderSpacing.Bottom = 12
Caption = 'Compute'
OnClick = ComputeBtnClick
TabOrder = 2
end
object ReturnBtn: TButton
AnchorSideLeft.Control = Panel1
AnchorSideRight.Control = Panel1
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Panel1
AnchorSideBottom.Side = asrBottom
Left = 0
Height = 25
Top = 166
Width = 76
Anchors = [akLeft, akRight, akBottom]
AutoSize = True
Caption = 'Return'
ModalResult = 1
TabOrder = 3
end
end
object Bevel1: TBevel
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = GroupBox1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 0
Height = 8
Top = 191
Width = 280
Anchors = [akTop, akLeft, akRight]
Shape = bsBottomLine
end
end

View File

@ -14,11 +14,10 @@ type
{ TPCurvesFrm }
TPCurvesFrm = class(TForm)
Panel1: TPanel;
Bevel1: TBevel;
ResetBtn: TButton;
CancelBtn: TButton;
ComputeBtn: TButton;
ReturnBtn: TButton;
CloseBtn: TButton;
Prob01: TCheckBox;
Prob025: TCheckBox;
Prob05: TCheckBox;
@ -33,11 +32,13 @@ type
Label2: TLabel;
Label3: TLabel;
procedure ComputeBtnClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ResetBtnClick(Sender: TObject);
private
{ private declarations }
function Validate(out AMsg: String; out AControl: TWinControl): Boolean;
public
{ public declarations }
end;
@ -47,6 +48,9 @@ var
implementation
uses
Math;
{ TPCurvesFrm }
procedure TPCurvesFrm.ResetBtnClick(Sender: TObject);
@ -65,170 +69,254 @@ end;
procedure TPCurvesFrm.FormShow(Sender: TObject);
begin
ResetBtnClick(self);
ResetBtnClick(self);
end;
procedure TPCurvesFrm.ComputeBtnClick(Sender: TObject);
var
mean, stddev, N, increment, althyp, power, zbeta, beta, StdErr : double;
XMax, offset : double;
ii : integer;
j, NoPlots, SetNo : integer;
alphas : array[1..6] of double;
zalphas : array[1..6] of double;
xalphas : array[1..6] of double;
XPlotPts : DblDyneMat;
YPlotPts : DblDyneMat;
LabelStr, outline, xTitle, yTitle : string;
oldCursor : TCursor;
mean, stddev, increment, althyp, power, zbeta, beta, StdErr: double;
XMax, offset: double;
N: Integer;
ii: integer;
j, NoPlots, SetNo: integer;
alphas: array[1..6] of double;
zalphas: array[1..6] of double;
xalphas: array[1..6] of double;
XPlotPts: DblDyneMat;
YPlotPts: DblDyneMat;
LabelStr, outline: string;
oldCursor: TCursor;
lReport: TStrings;
msg: String;
C: TWinControl;
begin
SetLength(YPlotPts,6,80);
SetLength(XPlotPts,1,80);
if not Validate(msg, C) then begin
C.SetFocus;
MessageDlg(msg, mtError, [mbOk], 0);
exit;
end;
XMax := 0.0;
mean := StrToFloat(NullEdit.Text);
stddev := StrToFloat(SDEdit.Text);
N := StrToFloat(NEdit.Text);
StdErr := stddev / sqrt(N); // standard error of mean;
increment := 4.0 * StdErr / 80.0; //scale for 80 points
SetLength(YPlotPts, 6, 80);
SetLength(XPlotPts, 1, 80);
// Initialize alternative type I error arrays
for ii := 1 to 6 do
begin
alphas[ii] := 0.0;
zalphas[ii] := 0.0;
xalphas[ii] := 0.0;
end;
XMax := 0.0;
mean := StrToFloat(NullEdit.Text);
stddev := StrToFloat(SDEdit.Text);
N := StrToInt(NEdit.Text);
StdErr := stddev / sqrt(N); // standard error of mean;
increment := 4.0 * StdErr / 80.0; //scale for 80 points
// Get the desired alpha (Beta) curve options
if (Prob01.Checked) then alphas[1] := 0.01;
if (Prob025.Checked) then alphas[2] := 0.025;
if (Prob05.Checked) then alphas[3] := 0.05;
if (Prob075.Checked) then alphas[4] := 0.075;
if (Prob10.Checked) then alphas[5] := 0.10;
if (Prob20.Checked) then alphas[6] := 0.20;
oldCursor := Screen.Cursor;
Screen.Cursor := TCursor(crHourGlass);
// Initialize alternative type I error arrays
for ii := 1 to 6 do
begin
alphas[ii] := 0.0;
zalphas[ii] := 0.0;
xalphas[ii] := 0.0;
end;
// For curves selected, obtain corresponding z and x values
for ii := 1 to 6 do
begin
if (alphas[ii] <> 0.0) then
begin
zalphas[ii] := inversez(1.0 - alphas[ii]);
xalphas[ii] := (zalphas[ii] * StdErr) + mean;
if (xalphas[ii] > XMax) then XMax := xalphas[ii];
end;
end;
// Get the desired alpha (Beta) curve options
if Prob01.Checked then alphas[1] := 0.01;
if Prob025.Checked then alphas[2] := 0.025;
if Prob05.Checked then alphas[3] := 0.05;
if Prob075.Checked then alphas[4] := 0.075;
if Prob10.Checked then alphas[5] := 0.10;
if Prob20.Checked then alphas[6] := 0.20;
// For each curve, obtain and plot 80 alternative hypotheses and
// their corresponding probabilities
NoPlots := 1;
for ii := 1 to 6 do // possible curves
begin
if (alphas[ii] <> 0.0) then // curve selected?
begin
Offset := 0.0;
for j := 1 to 80 do //get points to plot
begin
althyp := mean + Offset;
zbeta := (xalphas[ii] - althyp ) / StdErr;
if ( abs(zbeta) < 5.0) then beta := probz(zbeta)
else beta := 0.0;
power := 1.0 - beta;
XPlotPts[0,j-1] := althyp;
YPlotPts[NoPlots-1,j-1] := power;
Offset := offset + increment;
end;
NoPlots := NoPlots + 1;
end; // if alphas[i] <> 0
end; // next curve i
msg := 'At least one probability must be selected.';
for ii := 1 to 6 do
if alphas[ii] <> 0.0 then
begin
msg := '';
break;
end;
if msg <> '' then begin
Prob01.SetFocus;
MessageDlg(msg, mtError, [mbOK], 0);
exit;
end;
// Plot the points
GraphFrm.BackColor := clWhite;
GraphFrm.ShowLeftWall := true;
GraphFrm.ShowRightWall := true;
GraphFrm.ShowBottomWall := true;
GraphFrm.ShowBackWall := true;
GraphFrm.BackColor := clYellow;
GraphFrm.WallColor := clBlue;
GraphFrm.FloorColor := clBlue;
outline := format('z-Test Power. Pop. Mean := %6.2f, Sigma := %6.2f, N := %2.0f',[mean,stddev,N]);
GraphFrm.Heading := outline;
xTitle := format('%6.2f x INCREMENT ABOVE HYPOTHESIZED MEAN',[increment]);
GraphFrm.XTitle := xTitle;
yTitle := 'PROBABILITIES';
GraphFrm.YTitle := yTitle;
GraphFrm.nosets := NoPlots-1;
GraphFrm.nbars := 80;
GraphFrm.barwideprop := 0.5;
GraphFrm.miny := 0.0;
GraphFrm.maxy := 1.0;
GraphFrm.AutoScaled := false;
GraphFrm.GraphType := 5; // 2d line charts
GraphFrm.PtLabels := false;
oldCursor := Screen.Cursor;
Screen.Cursor := TCursor(crHourGlass);
lReport := TStringList.Create;
try
// For curves selected, obtain corresponding z and x values
for ii := 1 to 6 do
begin
if (alphas[ii] <> 0.0) then
begin
zalphas[ii] := inversez(1.0 - alphas[ii]);
xalphas[ii] := (zalphas[ii] * StdErr) + mean;
if (xalphas[ii] > XMax) then XMax := xalphas[ii];
end;
end;
SetNo := 1;
for ii := 1 to 6 do
begin
if (alphas[ii] <> 0.0) then
begin
LabelStr := format('%4.2f',[alphas[ii]]);
GraphFrm.SetLabels[SetNo] := LabelStr;
SetNo := SetNo + 1;
end;
end;
GraphFrm.Ypoints := YPlotPts;
GraphFrm.Xpoints := XPlotPts;
// For each curve, obtain and plot 80 alternative hypotheses and
// their corresponding probabilities
NoPlots := 1;
for ii := 1 to 6 do // possible curves
begin
if (alphas[ii] <> 0.0) then // curve selected?
begin
Offset := 0.0;
for j := 1 to 80 do //get points to plot
begin
althyp := mean + Offset;
zbeta := (xalphas[ii] - althyp ) / StdErr;
if (abs(zbeta) < 5.0) then
beta := probz(zbeta)
else
beta := 0.0;
power := 1.0 - beta;
XPlotPts[0,j-1] := althyp;
YPlotPts[NoPlots-1,j-1] := power;
Offset := offset + increment;
end;
NoPlots := NoPlots + 1;
end; // if alphas[i] <> 0
end; // next curve i
Screen.Cursor := oldCursor;
GraphFrm.ShowModal;
// Plot the points
GraphFrm.ShowLeftWall := true;
GraphFrm.ShowRightWall := true;
GraphFrm.ShowBottomWall := true;
GraphFrm.ShowBackWall := true;
GraphFrm.BackColor := GRAPH_BACK_COLOR;
GraphFrm.WallColor := GRAPH_WALL_COLOR;
GraphFrm.FloorColor := GRAPH_FLOOR_COLOR;
GraphFrm.Heading := Format('z-Test Power. Pop. Mean: %.2f, Sigma: %.2f, N: %d', [mean, stddev, N]);
GraphFrm.XTitle := Format('%.2f x INCREMENT ABOVE HYPOTHESIZED MEAN', [increment]);
GraphFrm.YTitle := 'PROBABILITIES';
GraphFrm.nosets := NoPlots-1;
GraphFrm.nbars := 80;
GraphFrm.barwideprop := 0.5;
GraphFrm.miny := 0.0;
GraphFrm.maxy := 1.0;
GraphFrm.AutoScaled := false;
GraphFrm.GraphType := 5; // 2d line charts
GraphFrm.PtLabels := false;
OutputFrm.RichEdit.Clear;
OutputFrm.RichEdit.Lines.Add('Power of the z-test for Alternate Hypotheses');
OutputFrm.RichEdit.Lines.Add('');
outline := 'Alpha Levels: ';
for ii := 1 to 6 do
begin
if (alphas[ii] <> 0.0) then
begin
LabelStr := format(' %4.2f ',[alphas[ii]]);
outline := outline + LabelStr;
end;
end;
OutputFrm.RichEdit.Lines.Add(outline);
OutputFrm.RichEdit.Lines.Add('');
outline := '';
for ii := 1 to 80 do
begin
outline := format('X := %6.2f ',[XPlotPts[0,ii-1]]);
SetNo := 1;
for j := 1 to 6 do
begin
if (alphas[j] <> 0.0) then
begin
LabelStr := format('%4.3f ',[YPlotPts[SetNo-1,ii-1]]);
outline := outline + LabelStr;
SetNo := SetNo + 1;
end;
end;
OutputFrm.RichEdit.Lines.Add(outline);
end;
OutputFrm.ShowModal;
SetNo := 1;
for ii := 1 to 6 do
begin
if (alphas[ii] <> 0.0) then
begin
LabelStr := Format('%4.2f', [alphas[ii]]);
GraphFrm.SetLabels[SetNo] := LabelStr;
SetNo := SetNo + 1;
end;
end;
GraphFrm.Ypoints := YPlotPts;
GraphFrm.Xpoints := XPlotPts;
// clean up the heap
XPlotPts := nil;
YPlotPts := nil;
Screen.Cursor := oldCursor;
GraphFrm.ShowModal;
lReport.Add('Power of the z-test for Alternate Hypotheses');
lReport.Add('');
outline := 'Alpha Levels: ';
for ii := 1 to 6 do
begin
if (alphas[ii] <> 0.0) then
begin
LabelStr := Format(' %4.2f ', [alphas[ii]]);
outline := outline + LabelStr;
end;
end;
lReport.Add(outline);
lReport.Add('');
outline := '';
for ii := 1 to 80 do
begin
outline := Format('X: %8.2f ', [XPlotPts[0, ii-1]]);
SetNo := 1;
for j := 1 to 6 do
begin
if (alphas[j] <> 0.0) then
begin
outline := outline + Format('%5.3f ', [YPlotPts[SetNo-1, ii-1]]);
SetNo := SetNo + 1;
end;
end;
lReport.Add(outline);
end;
DisplayReport(lReport);
finally
lReport.Free;
Screen.Cursor := oldCursor;
XPlotPts := nil;
YPlotPts := nil;
end;
end;
procedure TPCurvesFrm.FormActivate(Sender: TObject);
var
w: Integer;
begin
w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]);
ResetBtn.Constraints.MinWidth := w;
ComputeBtn.Constraints.MinWidth := w;
CloseBtn.Constraints.MinWidth := w;
end;
procedure TPCurvesFrm.FormCreate(Sender: TObject);
begin
if OutputFrm = nil then
Application.CreateForm(TOutputFrm, OutputFrm);
if GraphFrm = nil then
Application.CreateForm(TGraphFrm, GraphFrm);
end;
function TPCurvesFrm.Validate(out AMsg: String; out AControl: TWinControl): Boolean;
var
x: Double;
n: Integer;
begin
Result := false;
if NullEdit.Text = '' then
begin
AMsg := 'Mean must not be empty.';
AControl := NullEdit;
exit;
end;
if not TryStrToFloat(NullEdit.Text, x) then
begin
AMsg := 'No valid number specified for Mean.';
AControl := NullEdit;
exit;
end;
if SDEdit.Text = '' then
begin
AMsg := 'Standard deviation must not be empty.';
AControl := SDEdit;
exit;
end;
if not TryStrToFloat(SDEdit.Text, x) or (x <= 0) then
begin
AMsg := 'Standard deviation must be a positive number.';
AControl := SDEdit;
exit;
end;
if NEdit.Text = '' then
begin
AMsg := 'Sample size not specified.';
AControl := NEdit;
exit;
end;
if not TryStrToInt(NEdit.Text, n) or (n <= 0) then
begin
AMsg := 'Sample size must be a positive integer number.';
AControl := NEdit;
exit;
end;
Result := true;
end;
initialization
{$I pcurvesunit.lrs}