pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

StepFwdMRUnit: Refactor like the others. Less hints and warnings from general units. Update help.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7351 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-04-01 10:27:37 +00:00
parent 44da765dcc
commit 0ecff427ad
6 changed files with 595 additions and 490 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
applications/lazstats/docs/HelpNDoc/LazStats.hnd
View File

Binary file not shown.

6
applications/lazstats/source/LazStats.lpi
View File

@ -1397,14 +1397,14 @@
</SearchPaths>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<Checks>
<IOChecks Value="True"/>
</Checks>
<Optimizations>
<OptimizationLevel Value="2"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<UseExternalDbgSyms Value="True"/>
</Debugging>
<LinkSmart Value="True"/>
<Options>
<Win32>

250
applications/lazstats/source/forms/analysis/multiple_regression/stepfwdmrunit.lfm
View File

@ -1,12 +1,12 @@
object StepFwdFrm: TStepFwdFrm
Left = 677
Height = 461
Top = 239
Width = 469
Left = 989
Height = 470
Top = 243
Width = 476
AutoSize = True
Caption = 'Forward Stepwise Multiple Regression'
ClientHeight = 461
ClientWidth = 469
ClientHeight = 470
ClientWidth = 476
OnActivate = FormActivate
OnCreate = FormCreate
OnShow = FormShow
@ -25,24 +25,24 @@ object StepFwdFrm: TStepFwdFrm
ParentColor = False
end
object Label2: TLabel
AnchorSideLeft.Control = ListBox1
AnchorSideTop.Control = Owner
Left = 189
AnchorSideLeft.Control = SelList
AnchorSideTop.Control = InBtn
Left = 269
Height = 15
Top = 8
Top = 104
Width = 127
BorderSpacing.Top = 8
Caption = 'Variables to be Analyzed'
ParentColor = False
end
object Label3: TLabel
AnchorSideLeft.Control = DepVar
AnchorSideTop.Control = Owner
Left = 346
AnchorSideBottom.Control = DepVar
Left = 269
Height = 15
Top = 8
Top = 28
Width = 102
BorderSpacing.Top = 8
Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 2
Caption = 'Dependent Variable'
ParentColor = False
end
@ -51,11 +51,11 @@ object StepFwdFrm: TStepFwdFrm
AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = AllBtn
AnchorSideBottom.Control = GroupBox1
AnchorSideBottom.Control = GroupBox2
Left = 8
Height = 244
Height = 188
Top = 25
Width = 119
Width = 199
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 8
BorderSpacing.Top = 2
@ -63,90 +63,96 @@ object StepFwdFrm: TStepFwdFrm
BorderSpacing.Bottom = 8
ItemHeight = 0
MultiSelect = True
OnSelectionChange = SelListSelectionChange
TabOrder = 0
end
object InBtn: TBitBtn
AnchorSideLeft.Control = AllBtn
AnchorSideLeft.Control = Owner
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = VarList
Left = 144
AnchorSideTop.Control = DepOutBtn
AnchorSideTop.Side = asrBottom
Left = 224
Height = 28
Top = 25
Top = 104
Width = 28
BorderSpacing.Top = 24
Images = MainDataModule.ImageList
ImageIndex = 1
OnClick = InBtnClick
Spacing = 0
TabOrder = 1
TabOrder = 4
end
object OutBtn: TBitBtn
AnchorSideLeft.Control = AllBtn
AnchorSideLeft.Control = Owner
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = InBtn
AnchorSideTop.Side = asrBottom
Left = 144
Left = 224
Height = 28
Top = 57
Top = 136
Width = 28
BorderSpacing.Top = 4
Images = MainDataModule.ImageList
ImageIndex = 0
OnClick = OutBtnClick
Spacing = 0
TabOrder = 2
TabOrder = 5
end
object AllBtn: TBitBtn
AnchorSideLeft.Control = Owner
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = OutBtn
AnchorSideTop.Side = asrBottom
Left = 135
Left = 215
Height = 25
Top = 97
Top = 188
Width = 46
Anchors = [akTop]
AutoSize = True
BorderSpacing.Top = 12
BorderSpacing.Top = 24
Caption = 'ALL'
OnClick = AllBtnClick
Spacing = 0
TabOrder = 3
TabOrder = 6
end
object ListBox1: TListBox
object SelList: TListBox
AnchorSideLeft.Control = AllBtn
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Label2
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = DepInBtn
AnchorSideBottom.Control = VarList
AnchorSideBottom.Side = asrBottom
Left = 189
Height = 244
Top = 25
Width = 113
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = GroupBox2
Left = 269
Height = 92
Top = 121
Width = 199
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 8
BorderSpacing.Top = 2
BorderSpacing.Right = 8
ItemHeight = 0
TabOrder = 4
MultiSelect = True
OnSelectionChange = SelListSelectionChange
TabOrder = 7
end
object DepInBtn: TBitBtn
Left = 310
AnchorSideLeft.Control = Owner
AnchorSideLeft.Side = asrCenter
Left = 224
Height = 28
Top = 24
Width = 28
Anchors = [akTop]
Images = MainDataModule.ImageList
ImageIndex = 1
OnClick = DepInBtnClick
Spacing = 0
TabOrder = 5
TabOrder = 1
end
object DepOutBtn: TBitBtn
AnchorSideLeft.Control = DepInBtn
AnchorSideTop.Control = DepInBtn
AnchorSideTop.Side = asrBottom
Left = 310
Left = 224
Height = 28
Top = 52
Width = 28
@ -154,24 +160,28 @@ object StepFwdFrm: TStepFwdFrm
ImageIndex = 0
OnClick = DepOutBtnClick
Spacing = 0
TabOrder = 6
TabOrder = 2
end
object DepVar: TEdit
AnchorSideLeft.Control = DepInBtn
AnchorSideLeft.Control = AllBtn
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Label3
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 346
AnchorSideBottom.Control = DepOutBtn
AnchorSideBottom.Side = asrBottom
Left = 269
Height = 23
Top = 25
Width = 115
Anchors = [akTop, akLeft, akRight]
Top = 45
Width = 199
Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 8
BorderSpacing.Top = 2
BorderSpacing.Right = 8
TabOrder = 7
BorderSpacing.Bottom = 12
ReadOnly = True
TabOrder = 3
Text = 'DepVar'
end
object GroupBox1: TGroupBox
@ -179,8 +189,8 @@ object StepFwdFrm: TStepFwdFrm
AnchorSideBottom.Control = Bevel1
Left = 8
Height = 135
Top = 277
Width = 451
Top = 286
Width = 457
Anchors = [akLeft, akBottom]
AutoSize = True
BorderSpacing.Left = 8
@ -188,12 +198,12 @@ object StepFwdFrm: TStepFwdFrm
Caption = 'Options'
ChildSizing.LeftRightSpacing = 16
ChildSizing.TopBottomSpacing = 6
ChildSizing.HorizontalSpacing = 18
ChildSizing.HorizontalSpacing = 24
ChildSizing.VerticalSpacing = 2
ChildSizing.Layout = cclTopToBottomThenLeftToRight
ChildSizing.ControlsPerLine = 5
ClientHeight = 115
ClientWidth = 447
ClientWidth = 453
TabOrder = 9
object CPChkBox: TCheckBox
Left = 16
@ -236,7 +246,7 @@ object StepFwdFrm: TStepFwdFrm
TabOrder = 4
end
object SDChkBox: TCheckBox
Left = 230
Left = 236
Height = 19
Top = 6
Width = 201
@ -244,7 +254,7 @@ object StepFwdFrm: TStepFwdFrm
TabOrder = 5
end
object MatInChkBox: TCheckBox
Left = 230
Left = 236
Height = 19
Top = 27
Width = 201
@ -252,7 +262,7 @@ object StepFwdFrm: TStepFwdFrm
TabOrder = 6
end
object MatSaveChkBox: TCheckBox
Left = 230
Left = 236
Height = 19
Top = 48
Width = 201
@ -260,7 +270,7 @@ object StepFwdFrm: TStepFwdFrm
TabOrder = 7
end
object PredictChkBox: TCheckBox
Left = 230
Left = 236
Height = 19
Top = 69
Width = 201
@ -269,163 +279,149 @@ object StepFwdFrm: TStepFwdFrm
end
end
object ResetBtn: TButton
AnchorSideRight.Control = CancelBtn
AnchorSideRight.Control = ComputeBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 168
Left = 267
Height = 25
Top = 428
Top = 437
Width = 54
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 12
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 12
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Reset'
OnClick = ResetBtnClick
TabOrder = 10
end
object ComputeBtn: TButton
AnchorSideRight.Control = ReturnBtn
AnchorSideRight.Control = CloseBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 308
Left = 329
Height = 25
Top = 428
Top = 437
Width = 76
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 12
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 12
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Compute'
OnClick = ComputeBtnClick
TabOrder = 11
end
object CancelBtn: TButton
AnchorSideRight.Control = ComputeBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 234
Height = 25
Top = 428
Width = 62
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 12
BorderSpacing.Top = 8
BorderSpacing.Right = 12
BorderSpacing.Bottom = 8
Caption = 'Cancel'
ModalResult = 2
TabOrder = 12
end
object ReturnBtn: TButton
object CloseBtn: TButton
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 396
Left = 413
Height = 25
Top = 428
Width = 61
Top = 437
Width = 55
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 12
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 12
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Return'
ModalResult = 1
TabOrder = 13
Caption = 'Close'
ModalResult = 11
TabOrder = 12
end
object Bevel1: TBevel
AnchorSideLeft.Control = Owner
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = ReturnBtn
AnchorSideBottom.Control = CloseBtn
Left = 0
Height = 8
Top = 412
Width = 469
Top = 421
Width = 476
Anchors = [akLeft, akRight, akBottom]
Shape = bsBottomLine
end
object GroupBox2: TGroupBox
AnchorSideLeft.Control = DepInBtn
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = DepOutBtn
AnchorSideTop.Side = asrBottom
Left = 310
Height = 80
Top = 92
Width = 132
AnchorSideBottom.Control = GroupBox1
Left = 8
Height = 53
Top = 225
Width = 268
Anchors = [akLeft, akBottom]
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Top = 12
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Minimum Probability'
ClientHeight = 60
ClientWidth = 128
ClientHeight = 33
ClientWidth = 264
TabOrder = 8
object Label4: TLabel
AnchorSideLeft.Control = GroupBox2
AnchorSideTop.Control = InProb
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = InProb
Left = 25
Left = 18
Height = 15
Top = 6
Width = 44
Anchors = [akTop, akRight]
BorderSpacing.Left = 18
BorderSpacing.Right = 8
Caption = 'to Enter:'
ParentColor = False
end
object Label5: TLabel
AnchorSideTop.Control = ProbOut
AnchorSideLeft.Control = InProb
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = InProb
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = ProbOut
Left = 19
AnchorSideRight.Control = OutProb
Left = 144
Height = 15
Top = 33
Top = 6
Width = 50
Anchors = [akTop, akRight]
BorderSpacing.Left = 18
BorderSpacing.Left = 24
BorderSpacing.Right = 8
Caption = 'to Retain:'
ParentColor = False
end
object InProb: TEdit
AnchorSideLeft.Control = Label4
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = GroupBox2
AnchorSideRight.Control = GroupBox2
AnchorSideRight.Side = asrBottom
Left = 77
Left = 70
Height = 23
Top = 2
Width = 39
Anchors = [akTop, akRight]
Width = 50
BorderSpacing.Top = 2
BorderSpacing.Right = 12
TabOrder = 0
Text = 'InProb'
end
object ProbOut: TEdit
AnchorSideLeft.Control = InProb
object OutProb: TEdit
AnchorSideLeft.Control = Label5
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = InProb
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GroupBox2
AnchorSideRight.Side = asrBottom
Left = 77
Left = 202
Height = 23
Top = 29
Width = 39
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 4
Top = 2
Width = 50
BorderSpacing.Right = 12
BorderSpacing.Bottom = 8
TabOrder = 1
Text = 'Edit1'
Text = 'OutProb'
end
end
object Bevel2: TBevel

387
applications/lazstats/source/forms/analysis/multiple_regression/stepfwdmrunit.pas
View File

@ -20,8 +20,7 @@ type
OpenDialog1: TOpenDialog;
ResetBtn: TButton;
ComputeBtn: TButton;
CancelBtn: TButton;
ReturnBtn: TButton;
CloseBtn: TButton;
PredictChkBox: TCheckBox;
MatSaveChkBox: TCheckBox;
MatInChkBox: TCheckBox;
@ -34,7 +33,7 @@ type
CPChkBox: TCheckBox;
GroupBox1: TGroupBox;
InProb: TEdit;
ProbOut: TEdit;
OutProb: TEdit;
InBtn: TBitBtn;
Label4: TLabel;
Label5: TLabel;
@ -46,7 +45,7 @@ type
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
ListBox1: TListBox;
SelList: TListBox;
VarList: TListBox;
procedure AllBtnClick(Sender: TObject);
procedure ComputeBtnClick(Sender: TObject);
@ -56,11 +55,13 @@ type
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure InBtnClick(Sender: TObject);
procedure SelListSelectionChange(Sender: TObject; User: boolean);
procedure OutBtnClick(Sender: TObject);
procedure ResetBtnClick(Sender: TObject);
private
{ private declarations }
FAutoSized: boolean;
procedure UpdateBtnStates;
public
{ public declarations }
end;
@ -76,21 +77,18 @@ uses
{ TStepFwdFrm }
procedure TStepFwdFrm.ResetBtnClick(Sender: TObject);
VAR i : integer;
var
i: integer;
begin
VarList.Clear;
ListBox1.Clear;
SelList.Clear;
for i := 1 to NoVariables do
begin
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
end;
InBtn.Enabled := true;
OutBtn.Enabled := false;
DepInBtn.Enabled := true;
DepOutBtn.Enabled := false;
DepVar.Text := '';
InProb.Text := '0.05';
ProbOut.Text := '0.10';
InProb.Text := FormatFloat('0.00', DEFAULT_ALPHA_LEVEL);
OutProb.Text := FormatFloat('0.00', 0.10);
CPChkBox.Checked := false;
CovChkBox.Checked := false;
CorrsChkBox.Checked := true;
@ -109,13 +107,12 @@ begin
if FAutoSized then
exit;
w := MaxValue([ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]);
w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]);
ResetBtn.Constraints.MinWidth := w;
CancelBtn.Constraints.MinWidth := w;
ComputeBtn.Constraints.MinWidth := w;
ReturnBtn.Constraints.MinWidth := w;
CloseBtn.Constraints.MinWidth := w;
VarList.Constraints.MinHeight := Max(200, GroupBox2.Top + Groupbox2.Height - VarList.Top);
VarList.Constraints.MinHeight := Max(200, AllBtn.Top + AllBtn.Height - VarList.Top); //GroupBox2.Top + Groupbox2.Height - VarList.Top);
Constraints.MinWidth := Width;
Constraints.MinHeight := Height;
@ -135,28 +132,27 @@ begin
end;
procedure TStepFwdFrm.AllBtnClick(Sender: TObject);
var count, index : integer;
var
index: integer;
begin
count := VarList.Items.Count;
for index := 0 to count-1 do
begin
ListBox1.Items.Add(VarList.Items.Strings[index]);
end;
for index := 0 to VarList.Items.Count-1 do
SelList.Items.Add(VarList.Items[index]);
VarList.Clear;
UpdateBtnStates;
end;
procedure TStepFwdFrm.ComputeBtnClick(Sender: TObject);
Label CleanUp, lastone;
Label
lastone;
var
i, j, k, k1, NoVars, NCases,errcnt : integer;
errorcode : boolean;
Index, NoIndepVars : integer;
largest, R2, Constant: double;
StdErrEst, NewR2, LargestPartial : double;
pdf1, pdf2, PartF, PartProb, LargestProb, POut : double;
SmallestProb : double;
BetaWeights : DblDyneVec;
cellstring, outline: string;
cellstring: string;
corrs : DblDyneMat;
Means : DblDyneVec;
Variances : DblDyneVec;
@ -165,73 +161,104 @@ var
title : string;
RowLabels : StrDyneVec;
ColLabels : StrDyneVec;
IndRowLabels : StrDyneVec;
IndColLabels : StrDyneVec;
IndepCorrs : DblDyneMat;
// IndRowLabels : StrDyneVec;
// IndColLabels : StrDyneVec;
// IndepCorrs : DblDyneMat;
IndepInverse : DblDyneMat;
IndepIndex : IntDyneVec;
XYCorrs : DblDyneVec;
// XYCorrs : DblDyneVec;
matched : boolean;
Partial : DblDyneVec;
Candidate : IntDyneVec;
TempNoVars : Integer;
StepNo : integer;
filename : string;
errorcode : boolean = false;
lReport: TStrings;
tmp: Double;
begin
if NoVariables = 0 then NoVariables := 200;
if InProb.Text = '' then
begin
InProb.SetFocus;
MessageDlg('Probability to enter not specified.', mtError, [mbOK], 0);
exit;
end;
if OutProb.Text = '' then
begin
OutProb.SetFocus;
MessageDlg('Probability to retain not specified.', mtError, [mbOK], 0);
exit;
end;
if not TryStrToFloat(InProb.Text, tmp) then
begin
InProb.SetFocus;
MessageDlg('No valid number.', mtError, [mbOK], 0);
exit;
end;
if not TryStrToFloat(OutProb.Text, tmp) then
begin
OutProb.SetFocus;
MessageDlg('No valid number.', mtError, [mbOK], 0);
exit;
end;
if NoVariables = 0 then
NoVariables := 200;
SetLength(corrs, NoVariables+1, NoVariables+1);
SetLength(IndepCorrs,NoVariables,NoVariables);
// SetLength(IndepCorrs, NoVariables, NoVariables);
SetLength(IndepInverse, NoVariables, NoVariables);
SetLength(Means, NoVariables);
SetLength(Variances, NoVariables);
SetLength(StdDevs, NoVariables);
SetLength(RowLabels, NoVariables);
SetLength(ColLabels, NoVariables);
SetLength(XYCorrs,NoVariables);
// SetLength(XYCorrs, NoVariables);
SetLength(IndepIndex, NoVariables);
SetLength(IndColLabels,NoVariables);
SetLength(IndRowLabels,NoVariables);
// SetLength(IndColLabels, NoVariables);
// SetLength(IndRowLabels, NoVariables);
SetLength(BetaWeights, NoVariables);
SetLength(Partial, NoVariables);
SetLength(Candidate, NoVariables);
SetLength(ColNoSelected, NoVariables);
OutputFrm.RichEdit.Clear;
// OutputFrm.RichEdit.ParaGraph.Alignment := taLeftJustify;
OutputFrm.RichEdit.Lines.Add('Stepwise Multiple Regression by Bill Miller');
lReport := TStringList.Create;
try
lReport.Add('STEPWISE MULTIPLE REGRESSION by Bill Miller');
StepNo := 1;
errcnt := 0;
errorcode := false;
if MatInChkBox.Checked = true then
if MatInChkBox.Checked then
begin
OpenDialog1.Filter := 'OS3 matrix files (*.MAT)|*.MAT|All files (*.*)|*.*';
OpenDialog1.Filter := 'LazStats matrix files (*.mat)|*.mat;*.MAT|All files (*.*)|*.*';
OpenDialog1.FilterIndex := 1;
if OpenDialog1.Execute then
begin
filename := OpenDialog1.FileName;
MATREAD(Corrs,NoVars,NoVars,Means,StdDevs,NCases,RowLabels,ColLabels,filename);
MatRead(Corrs, NoVars, NoVars, Means, StdDevs, NCases, RowLabels, ColLabels, filename);
for i := 0 to NoVars-1 do
begin
Variances[i] := sqr(StdDevs[i]);
ColNoSelected[i] := i+1;
end;
DepVar.Text := RowLabels[NoVars-1];
for i := 0 to NoVars-2 do ListBox1.Items.Add(RowLabels[i]);
ShowMessage('NOTICE! Last variable in matrix is the dependent variable');
for i := 0 to NoVars-2 do SelList.Items.Add(RowLabels[i]);
Messagedlg('Last variable in matrix is the dependent variable.', mtInformation, [mbOK], 0);
end;
end;
if MatInChkBox.Checked = false then
if not MatInChkBox.Checked then
begin
{ get independent item columns }
NoVars := ListBox1.Items.Count;
NoVars := SelList.Items.Count;
if NoVars < 1 then
begin
ShowMessage('ERROR! No independent variables selected.');
goto CleanUp;
MessageDlg('No independent variables selected.', mtError, [mbOK], 0);
exit;
end;
for i := 0 to NoVars-1 do
begin
cellstring := ListBox1.Items.Strings[i];
cellstring := SelList.Items.Strings[i];
for j := 1 to NoVariables do
begin
if cellstring = OS3MainFrm.DataGrid.Cells[j,0] then
@ -242,12 +269,14 @@ begin
end;
end;
end;
{ get dependendent variable column }
if DepVar.Text = '' then
begin
ShowMessage('ERROR! No Dependent variable selected.');
goto CleanUp;
MessageDlg('No Dependent variable selected.', mtError, [mbOK], 0);
exit;
end;
NoVars := NoVars + 1;
for j := 1 to NoVariables do
begin
@ -258,58 +287,78 @@ begin
ColLabels[NoVars-1] := DepVar.Text;
end;
end;
if CPChkBox.Checked = true then
if CPChkBox.Checked then
begin
title := 'Cross-Products Matrix';
GridXProd(NoVars, ColNoSelected, Corrs, errorcode, NCases);
MAT_PRINT(Corrs,NoVars,NoVars,title,RowLabels,ColLabels,NCases);
MatPrint(Corrs, NoVars, NoVars, title, RowLabels, ColLabels, NCases, lReport);
lReport.Add('');
end;
if CovChkBox.Checked = true then
if CovChkBox.Checked then
begin
title := 'Variance-Covariance Matrix';
GridCovar(NoVars,ColNoSelected,Corrs,Means,Variances,
StdDevs,errorcode,NCases);
MAT_PRINT(Corrs,NoVars,NoVars,title,RowLabels,ColLabels,NCases);
GridCovar(NoVars, ColNoSelected, Corrs, Means, Variances, StdDevs, errorcode, NCases);
MatPrint(Corrs, NoVars, NoVars, title, RowLabels, ColLabels, NCases, lReport);
lReport.Add('');
end;
Correlations(NoVars,ColNoSelected,Corrs,Means,Variances,
StdDevs,errorcode,NCases);
Correlations(NoVars, ColNoSelected, Corrs, Means, Variances, StdDevs, errorcode, NCases);
end;
if CorrsChkBox.Checked = true then
if CorrsChkBox.Checked then
begin
title := 'Product-Moment Correlations Matrix';
MAT_PRINT(Corrs,NoVars,NoVars,title,RowLabels,ColLabels,NCases);
MatPrint(Corrs, NoVars, NoVars, title, RowLabels, ColLabels, NCases, lReport);
lReport.Add('');
end;
if MatSaveChkBox.Checked = true then
if MatSaveChkBox.Checked then
begin
SaveDialog1.Filter := 'OS3 matrix files (*.MAT)|*.MAT|All files (*.*)|*.*';
SaveDialog1.Filter := 'LazStats matrix files (*.mat)|*.mat;*.MAT|All files (*.*)|*.*';
SaveDialog1.FilterIndex := 1;
if SaveDialog1.Execute then
begin
filename := SaveDialog1.FileName;
MATSAVE(Corrs,NoVars,NoVars,Means,StdDevs,NCases,RowLabels,ColLabels,filename);
MatSave(Corrs, NoVars, NoVars, Means, StdDevs, NCases, RowLabels, ColLabels, filename);
end;
end;
title := 'Means';
if MeansChkBox.Checked = true then
DynVectorPrint(Means,NoVars,title,ColLabels,NCases);
begin
title := 'Means';
DynVectorPrint(Means, NoVars, title, ColLabels, NCases, lReport);
lReport.Add('');
end;
if VarChkBox.Checked then
begin
title := 'Variances';
if VarChkBox.Checked = true then
DynVectorPrint(Variances,NoVars,title,ColLabels,NCases);
title := 'Standard Deviations';
DynVectorPrint(Variances, NoVars, title, ColLabels, NCases, lReport);
lReport.Add('');
end;
if SDChkBox.Checked = true then
DynVectorPrint(StdDevs,NoVars,title,ColLabels,NCases);
begin
title := 'Standard Deviations';
DynVectorPrint(StdDevs, NoVars, title, ColLabels, NCases, lReport);
lReport.Add('');
end;
if errorcode then
begin
OutputFrm.RichEdit.Lines.Add('One or more correlations could not be computed due to zero variance of a variable.');
lReport.Add('One or more correlations could not be computed due to zero variance of a variable.');
DisplayReport(lReport);
MessageDlg('A selected variable has no variability-run aborted.', mtError, [mbOk], 0);
exit;
end;
OutputFrm.ShowModal;
if errorcode then
begin
ShowMessage('ERROR! A selected variable has no variability-run aborted.');
goto CleanUp;
end;
OutputFrm.RichEdit.Clear;
OutputFrm.RichEdit.Lines.Add('Stepwise Multiple Regression by Bill Miller');
lReport.Add('');
lReport.Add('=====================================================================');
lReport.Add('');
lReport.Add('STEPWISE MULTIPLE REGRESSION by Bill Miller');
{ Select largest correlation to begin. Note: dependent is last variable }
largest := 0.0;
@ -324,14 +373,18 @@ begin
end;
NoIndepVars := 1;
IndepIndex[NoIndepVars-1] := Index;
POut := StrToFloat(ProbOut.Text);
OutputFrm.RichEdit.Lines.Add('');
outline := format('----------------- STEP %d ------------------',[StepNo]);
OutputFrm.RichEdit.Lines.Add(outline);
POut := StrToFloat(OutProb.Text);
lReport.Add('');
lReport.Add('----------------- STEP %d ------------------', [StepNo]);
MReg2(NCases, NoVars, NoIndepVars, IndepIndex, corrs, IndepInverse,
RowLabels, R2, BetaWeights,
Means,Variances,errcnt,StdErrEst,constant,POut,true, true,false, OutputFrm.RichEdit.Lines);
OutputFrm.ShowModal;
Means, Variances, errcnt, StdErrEst, constant, POut, true, true, false,
lReport);
lReport.Add('');
lReport.Add('=====================================================================');
lReport.Add('');
while NoIndepVars < NoVars-1 do
begin
{ select the next independent variable based on the largest
@ -341,6 +394,7 @@ begin
variable with all previously entered variables plus a candidate
variable and the squared MC with just the previously entered
variables ( the previously obtained R2 ). }
{ build list of candidates }
StepNo := StepNo + 1;
k := 0;
@ -348,18 +402,19 @@ begin
begin
matched := false;
for j := 0 to NoIndepVars-1 do
begin
if IndepIndex[j] = i then matched := true;
end;
if (matched = false) then
if not matched then
begin
k := k + 1;
Candidate[k-1] := i;
end;
end; { k is the no. of candidates }
OutputFrm.RichEdit.Lines.Add('');
OutputFrm.RichEdit.Lines.Add('Candidates for entry in next step.');
OutputFrm.RichEdit.Lines.Add('Candidate Partial F Statistic Prob. DF1 DF2');
lReport.Add('');
lReport.Add('Candidates for entry in next step:');
lReport.Add('');
lReport.Add('Candidate Partial F Statistic Prob. DF1 DF2');
LargestProb := 0.0;
SmallestProb := 1.0;
for k1 := 1 to k do
@ -369,7 +424,7 @@ begin
TempNoVars := NoIndepVars + 1;
MReg2(NCases, NoVars, TempNoVars, IndepIndex, corrs, IndepInverse,
RowLabels, NewR2, BetaWeights, Means, Variances,
errcnt, StdErrEst, constant, POut, false, false,false, OutputFrm.RichEdit.Lines);
errcnt, StdErrEst, constant, POut, false, false,false, lReport);
Partial[k1-1] := (NewR2 - R2) / (1.0 - R2);
pdf1 := 1;
pdf2 := NCases - TempNoVars - 1;
@ -377,16 +432,19 @@ begin
PartProb := probf(PartF, pdf1, pdf2);
if PartProb < SmallestProb then SmallestProb := PartProb;
if PartProb > LargestProb then LargestProb := PartProb;
outline := format('%-10s %6.4f %7.4f %6.4f %3.0f %3.0f',
[RowLabels[Candidate[k1-1]-1], sqrt(abs(Partial[k1-1])), PartF, PartProb, pdf1, pdf2]);
OutputFrm.RichEdit.Lines.Add(outline);
lReport.Add('%-10s %6.4f %7.4f %6.4f %3.0f %3.0f', [
RowLabels[Candidate[k1-1]-1],
sqrt(abs(Partial[k1-1])),
PartF, PartProb, pdf1, pdf2
]);
end;
if (SmallestProb > StrToFloat(InProb.Text)) then
begin
OutputFrm.RichEdit.Lines.Add('No further steps meet criterion for entry.');
lReport.Add('No further steps meet criterion for entry.');
goto lastone;
end;
{ select variable with largest partial to enter next }
largestpartial := 0.0;
Index := 1;
@ -399,99 +457,154 @@ begin
end;
end;
outline := format('Variable %s will be added',[RowLabels[Index-1]]);
OutputFrm.RichEdit.Lines.Add(outline);
lReport.Add('Variable %s will be added', [RowLabels[Index-1]]);
NoIndepVars := NoIndepVars + 1;
IndepIndex[NoIndepVars-1] := Index;
OutputFrm.RichEdit.Lines.Add('');
outline := format('----------------- STEP %d ------------------',[StepNo]);
OutputFrm.RichEdit.Lines.Add(outline);
lReport.Add('');
lReport.Add('----------------- STEP %d ------------------', [StepNo]);
MReg2(NCases, NoVars, NoIndepVars, IndepIndex, corrs, IndepInverse,
RowLabels, R2, BetaWeights, Means, Variances,
errcnt, StdErrEst, constant,POut,true,true,false, OutputFrm.RichEdit.Lines);
errcnt, StdErrEst, constant, POut, true, true, false, lReport);
if (errcnt > 0) or (NoIndepVars = NoVars-1) then { out tolerance exceeded - finish up }
lastone: begin
OutputFrm.RichEdit.Lines.Add('');
OutputFrm.RichEdit.Lines.Add('-------------FINAL STEP-----------');
lastone:
begin
lReport.Add('');
lReport.Add('-------------FINAL STEP-----------');
MReg2(NCases, NoVars, NoIndepVars, IndepIndex, corrs, IndepInverse,
RowLabels, NewR2, BetaWeights, Means, Variances,
errcnt,StdErrEst,constant,POut,true,false,false, OutputFrm.RichEdit.Lines);
errcnt, StdErrEst, constant, POut, true, false, false, lReport);
k1 := NoIndepVars; { store temporarily }
NoIndepVars := NoVars; { this stops loop }
end;
end; { while not done }
OutputFrm.ShowModal;
lReport.Add('');
lReport.Add('=====================================================================');
lReport.Add('');
NoIndepVars := k1;
{ add [predicted scores, residual scores, etc. to grid if options elected }
if MatInChkBox.Checked = true then PredictChkBox.Checked := false;
if PredictChkBox.Checked = true then
Predict(ColNoSelected, NoVars, IndepInverse, Means, StdDevs,
BetaWeights, StdErrEst, IndepIndex, NoIndepVars);
if MatInChkBox.Checked then PredictChkBox.Checked := false;
if PredictChkBox.Checked then
Predict(ColNoSelected, NoVars, IndepInverse, Means, StdDevs, BetaWeights, StdErrEst, IndepIndex, NoIndepVars);
CleanUp:
DisplayReport(lReport);
finally
lReport.Free;
ColNoSelected := nil;
Candidate := nil;
Partial := nil;
BetaWeights := nil;
IndColLabels := nil;
IndRowLabels := nil;
// IndColLabels := nil;
// IndRowLabels := nil;
IndepIndex := nil;
XYCorrs := nil;
// XYCorrs := nil;
ColLabels := nil;
RowLabels := nil;
StdDevs := nil;
Variances := nil;
Means := nil;
IndepInverse := nil;
IndepCorrs := nil;
// IndepCorrs := nil;
corrs := nil;
end;
end;
procedure TStepFwdFrm.DepInBtnClick(Sender: TObject);
VAR index : integer;
var
index: integer;
begin
index := ListBox1.ItemIndex;
DepVar.Text := ListBox1.Items.Strings[index];
ListBox1.Items.Delete(index);
DepOutBtn.Enabled := true;
DepInBtn.Enabled := false;
index := VarList.ItemIndex;
if (index > -1) and (DepVar.Text = '') then
begin
DepVar.Text := VarList.Items[index];
VarList.Items.Delete(index);
end;
UpdateBtnStates;
end;
procedure TStepFwdFrm.DepOutBtnClick(Sender: TObject);
begin
ListBox1.Items.Add(DepVar.Text);
if DepVar.Text <> '' then
begin
VarList.Items.Add(DepVar.Text);
DepVar.Text := '';
DepInBtn.Enabled := true;
end;
UpdateBtnStates;
end;
procedure TStepFwdFrm.InBtnClick(Sender: TObject);
VAR i, index : integer;
var
i: integer;
begin
index := VarList.Items.Count;
i := 0;
while i < index do
while i < VarList.Items.Count do
begin
if (VarList.Selected[i]) then
if VarList.Selected[i] then
begin
ListBox1.Items.Add(VarList.Items.Strings[i]);
SelList.Items.Add(VarList.Items[i]);
VarList.Items.Delete(i);
index := index - 1;
i := 0;
end
else i := i + 1;
else
i := i + 1;
end;
OutBtn.Enabled := true;
UpdateBtnStates;
end;
procedure TStepFwdFrm.SelListSelectionChange(Sender: TObject; User: boolean);
begin
UpdateBtnStates;
end;
procedure TStepFwdFrm.OutBtnClick(Sender: TObject);
VAR index : integer;
var
i: integer;
begin
index := ListBox1.ItemIndex;
VarList.Items.Add(ListBox1.Items.Strings[index]);
ListBox1.Items.Delete(index);
InBtn.Enabled := true;
i := 0;
while i < SelList.Items.Count do
begin
if SelList.Selected[i] then
begin
VarList.Items.Add(SelList.Items[i]);
SelList.Items.Delete(i);
i := 0;
end
else
i := i + 1;
end;
UpdateBtnStates;
end;
procedure TStepFwdFrm.UpdateBtnStates;
var
lSelected: Boolean;
i: Integer;
begin
DepInBtn.Enabled := (VarList.ItemIndex > -1) and (DepVar.Text = '');
DepOutBtn.Enabled := (DepVar.Text <> '');
lSelected := false;
for i:=0 to VarList.Items.Count-1 do
if VarList.Selected[i] then
begin
lSelected := true;
break;
end;
InBtn.Enabled := lSelected;
lSelected := false;
for i := 0 to SelList.Items.Count-1 do
if SelList.Selected[i] then
begin
lSelected := true;
break;
end;
OutBtn.Enabled := lSelected;
end;
initialization
{$I stepfwdmrunit.lrs}

36
applications/lazstats/source/units/dataprocs.pas
View File

@ -31,15 +31,9 @@ procedure OpenTabFile;
procedure SaveTabFile;
function ValidValue(row, col : integer) : boolean;
function IsFiltered(GridRow : integer) : boolean;
procedure MATREAD(VAR a : DblDyneMat;
VAR norows : integer;
VAR nocols : integer;
VAR means : DblDyneVec;
VAR stddevs : DblDyneVec;
VAR NCases : integer;
VAR RowLabels : StrDyneVec;
VAR ColLabels : StrDyneVec;
filename : string);
procedure MatRead(var a: DblDyneMat; out NoRows, NoCols: integer;
var Means, StdDevs: DblDyneVec; out NCases: integer;
var RowLabels, ColLabels: StrDyneVec; const filename: string);
procedure MATSAVE(VAR a : DblDyneMat;
norows : integer;
nocols : integer;
@ -832,15 +826,12 @@ begin
end;
//-------------------------------------------------------------------
procedure MATREAD(VAR a : DblDyneMat;
VAR norows : integer;
VAR nocols : integer;
VAR means : DblDyneVec;
VAR stddevs : DblDyneVec;
VAR NCases : integer;
VAR RowLabels : StrDyneVec;
VAR ColLabels : StrDyneVec;
filename : string);
procedure MATREAD(var a: DblDyneMat;
out NoRows, NoCols: integer;
var means, stddevs: DblDyneVec;
out NCases: integer;
var RowLabels, ColLabels: StrDyneVec;
const filename: string);
var i, j : integer;
mat_file : TextFile;
begin
@ -849,6 +840,11 @@ begin
readln(mat_file,norows);
readln(mat_file,nocols);
readln(mat_file,NCases);
// wp: Setlength missing here --> very critical !!!!
// I understand that the calling routine pre-allocates these arrays
// But there should be a check whehter Norows, etc do not go beyond array size.
for i := 1 to norows do readln(mat_file,RowLabels[i-1]);
for i := 1 to nocols do readln(mat_file,ColLabels[i-1]);
for i := 1 to nocols do readln(mat_file,means[i-1]);
@ -897,7 +893,7 @@ begin
if FileExists(filename) then
begin
fileext := ExtractFileExt(filename);
fileext := Uppercase(ExtractFileExt(filename));
OS3MainFrm.FileNameEdit.Text := filename;
OS3MainFrm.OpenDialog1.FileName := filename;
if fileext = '.CSV' then OpenCommaFile
@ -906,7 +902,7 @@ begin
else if fileext = '.SSV' then OpenSpaceFile;
end
else begin
ShowMessage('ERROR! ' + filename + ' not found');
MessageDlg(filename + ' not found.', mtError, [mbOK], 0);
exit;
end;
end;

12
applications/lazstats/source/units/matrixlib.pas
View File

@ -128,13 +128,13 @@ procedure MReg2(NCases : integer;
VAR corrs : DblDyneMat;
VAR IndepCorrs : DblDyneMat;
VAR RowLabels : StrDyneVec;
VAR R2 : double;
out R2: double;
VAR BetaWeights : DblDyneVec;
VAR Means : DblDyneVec;
VAR Variances : DblDyneVec;
VAR errorcode : integer;
VAR StdErrEst : double;
VAR constant : double;
out StdErrEst: double;
out constant: double;
probout : double;
Printit : boolean;
TestOut : boolean;
@ -1260,13 +1260,13 @@ procedure MReg2(NCases : integer;
VAR corrs : DblDyneMat;
VAR IndepCorrs : DblDyneMat;
VAR RowLabels : StrDyneVec;
VAR R2 : double;
out R2: double;
VAR BetaWeights : DblDyneVec;
VAR Means : DblDyneVec;
VAR Variances : DblDyneVec;
VAR errorcode : integer;
VAR StdErrEst : double;
VAR constant : double;
out StdErrEst: double;
out constant: double;
probout : double;
Printit : boolean;
TestOut : boolean;