StepFwdMRUnit, BackRegUnit: like the others.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7352 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-04-03 14:43:33 +00:00
parent 0ecff427ad
commit bc4f786194
6 changed files with 416 additions and 334 deletions

View File

@ -1,12 +1,12 @@
object BackRegFrm: TBackRegFrm object BackRegFrm: TBackRegFrm
Left = 622 Left = 622
Height = 437 Height = 436
Top = 187 Top = 187
Width = 454 Width = 463
AutoSize = True AutoSize = True
Caption = 'Stepwise Backward Multiple Regression' Caption = 'Stepwise Backward Multiple Regression'
ClientHeight = 437 ClientHeight = 436
ClientWidth = 454 ClientWidth = 463
OnActivate = FormActivate OnActivate = FormActivate
OnCreate = FormCreate OnCreate = FormCreate
OnShow = FormShow OnShow = FormShow
@ -25,24 +25,25 @@ object BackRegFrm: TBackRegFrm
ParentColor = False ParentColor = False
end end
object Label2: TLabel object Label2: TLabel
AnchorSideLeft.Control = ListBox1 AnchorSideLeft.Control = SelList
AnchorSideTop.Control = Owner AnchorSideTop.Control = InBtn
Left = 178 Left = 262
Height = 15 Height = 15
Top = 8 Top = 109
Width = 127 Width = 127
BorderSpacing.Top = 8
Caption = 'Variables to be Analyzed' Caption = 'Variables to be Analyzed'
ParentColor = False ParentColor = False
end end
object Label3: TLabel object Label3: TLabel
AnchorSideLeft.Control = DepVar AnchorSideLeft.Control = DepVar
AnchorSideTop.Control = Owner AnchorSideTop.Side = asrBottom
Left = 338 AnchorSideBottom.Control = DepVar
Left = 262
Height = 15 Height = 15
Top = 8 Top = 33
Width = 102 Width = 102
BorderSpacing.Top = 8 Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 2
Caption = 'Dependent Variable' Caption = 'Dependent Variable'
ParentColor = False ParentColor = False
end end
@ -55,7 +56,7 @@ object BackRegFrm: TBackRegFrm
Left = 8 Left = 8
Height = 220 Height = 220
Top = 25 Top = 25
Width = 108 Width = 192
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Top = 2 BorderSpacing.Top = 2
@ -64,105 +65,128 @@ object BackRegFrm: TBackRegFrm
Constraints.MinHeight = 220 Constraints.MinHeight = 220
ItemHeight = 0 ItemHeight = 0
MultiSelect = True MultiSelect = True
OnSelectionChange = VarListSelectionChange
TabOrder = 0 TabOrder = 0
end end
object InBtn: TBitBtn object InBtn: TBitBtn
AnchorSideLeft.Control = AllBtn AnchorSideLeft.Control = Owner
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
Left = 133 AnchorSideTop.Control = DepOutBtn
AnchorSideTop.Side = asrBottom
Left = 217
Height = 28 Height = 28
Top = 26 Top = 109
Width = 28 Width = 28
BorderSpacing.Top = 24
Images = MainDataModule.ImageList Images = MainDataModule.ImageList
ImageIndex = 1 ImageIndex = 1
OnClick = InBtnClick OnClick = InBtnClick
Spacing = 0 Spacing = 0
TabOrder = 1 TabOrder = 4
end end
object OutBtn: TBitBtn object OutBtn: TBitBtn
AnchorSideLeft.Control = AllBtn AnchorSideLeft.Control = Owner
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
Left = 133 AnchorSideTop.Control = InBtn
AnchorSideTop.Side = asrBottom
Left = 217
Height = 28 Height = 28
Top = 56 Top = 141
Width = 28 Width = 28
BorderSpacing.Top = 4
Images = MainDataModule.ImageList Images = MainDataModule.ImageList
ImageIndex = 0 ImageIndex = 0
OnClick = OutBtnClick OnClick = OutBtnClick
Spacing = 0 Spacing = 0
TabOrder = 2 TabOrder = 5
end end
object AllBtn: TBitBtn object AllBtn: TBitBtn
Left = 124 AnchorSideLeft.Control = Owner
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = OutBtn
AnchorSideTop.Side = asrBottom
Left = 208
Height = 25 Height = 25
Top = 120 Top = 193
Width = 46 Width = 46
Anchors = [akTop]
AutoSize = True AutoSize = True
BorderSpacing.Top = 24
Caption = 'ALL' Caption = 'ALL'
OnClick = AllBtnClick OnClick = AllBtnClick
Spacing = 0 Spacing = 0
TabOrder = 3 TabOrder = 6
end end
object ListBox1: TListBox object SelList: TListBox
AnchorSideLeft.Control = AllBtn AnchorSideLeft.Control = AllBtn
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Label2 AnchorSideTop.Control = Label2
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = DepInBtn AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = GroupBox1 AnchorSideBottom.Control = GroupBox1
Left = 178 Left = 262
Height = 220 Height = 118
Top = 25 Top = 126
Width = 116 Width = 193
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Top = 2 BorderSpacing.Top = 2
BorderSpacing.Right = 8 BorderSpacing.Right = 8
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
ItemHeight = 0 ItemHeight = 0
TabOrder = 4 MultiSelect = True
OnSelectionChange = VarListSelectionChange
TabOrder = 7
end end
object DepInBtn: TBitBtn object DepInBtn: TBitBtn
Left = 302 AnchorSideLeft.Control = Owner
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = VarList
Left = 217
Height = 28 Height = 28
Top = 24 Top = 25
Width = 28 Width = 28
Anchors = [akTop]
Images = MainDataModule.ImageList Images = MainDataModule.ImageList
ImageIndex = 1 ImageIndex = 1
OnClick = DepInBtnClick OnClick = DepInBtnClick
Spacing = 0 Spacing = 0
TabOrder = 5 TabOrder = 1
end end
object DepOutBtn: TBitBtn object DepOutBtn: TBitBtn
AnchorSideLeft.Control = DepInBtn AnchorSideLeft.Control = Owner
Left = 302 AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = DepInBtn
AnchorSideTop.Side = asrBottom
Left = 217
Height = 28 Height = 28
Top = 56 Top = 57
Width = 28 Width = 28
BorderSpacing.Top = 4
Images = MainDataModule.ImageList Images = MainDataModule.ImageList
ImageIndex = 0 ImageIndex = 0
OnClick = DepOutBtnClick OnClick = DepOutBtnClick
Spacing = 0 Spacing = 0
TabOrder = 6 TabOrder = 2
end end
object DepVar: TEdit object DepVar: TEdit
AnchorSideLeft.Control = DepInBtn AnchorSideLeft.Control = AllBtn
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Label3 AnchorSideTop.Control = Label3
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 338 AnchorSideBottom.Control = DepOutBtn
AnchorSideBottom.Side = asrBottom
Left = 262
Height = 23 Height = 23
Top = 25 Top = 50
Width = 108 Width = 193
Anchors = [akTop, akLeft, akRight] Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Top = 2
BorderSpacing.Right = 8 BorderSpacing.Right = 8
TabOrder = 7 BorderSpacing.Bottom = 12
ReadOnly = True
TabOrder = 3
Text = 'DepVar' Text = 'DepVar'
end end
object GroupBox1: TGroupBox object GroupBox1: TGroupBox
@ -170,7 +194,7 @@ object BackRegFrm: TBackRegFrm
AnchorSideBottom.Control = Bevel1 AnchorSideBottom.Control = Bevel1
Left = 8 Left = 8
Height = 135 Height = 135
Top = 253 Top = 252
Width = 439 Width = 439
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
AutoSize = True AutoSize = True
@ -260,98 +284,79 @@ object BackRegFrm: TBackRegFrm
end end
end end
object ResetBtn: TButton object ResetBtn: TButton
AnchorSideRight.Control = CancelBtn AnchorSideRight.Control = ComputeBtn
AnchorSideBottom.Control = Owner AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 153 Left = 254
Height = 25 Height = 25
Top = 404 Top = 403
Width = 54 Width = 54
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
AutoSize = True AutoSize = True
BorderSpacing.Left = 12 BorderSpacing.Left = 8
BorderSpacing.Top = 8 BorderSpacing.Top = 8
BorderSpacing.Right = 12 BorderSpacing.Right = 8
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
Caption = 'Reset' Caption = 'Reset'
OnClick = ResetBtnClick OnClick = ResetBtnClick
TabOrder = 9 TabOrder = 9
end end
object CancelBtn: TButton
AnchorSideRight.Control = ComputeBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 219
Height = 25
Top = 404
Width = 62
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 12
BorderSpacing.Top = 8
BorderSpacing.Right = 12
BorderSpacing.Bottom = 8
Caption = 'Cancel'
ModalResult = 2
OnClick = CancelBtnClick
TabOrder = 10
end
object ComputeBtn: TButton object ComputeBtn: TButton
AnchorSideRight.Control = ReturnBtn AnchorSideRight.Control = CloseBtn
AnchorSideBottom.Control = Owner AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 293 Left = 316
Height = 25 Height = 25
Top = 404 Top = 403
Width = 76 Width = 76
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
AutoSize = True AutoSize = True
BorderSpacing.Left = 12 BorderSpacing.Left = 8
BorderSpacing.Top = 8 BorderSpacing.Top = 8
BorderSpacing.Right = 12 BorderSpacing.Right = 8
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
Caption = 'Compute' Caption = 'Compute'
OnClick = ComputeBtnClick OnClick = ComputeBtnClick
TabOrder = 11 TabOrder = 10
end end
object ReturnBtn: TButton object CloseBtn: TButton
AnchorSideRight.Control = Owner AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 381 Left = 400
Height = 25 Height = 25
Top = 404 Top = 403
Width = 61 Width = 55
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
AutoSize = True AutoSize = True
BorderSpacing.Left = 12 BorderSpacing.Left = 8
BorderSpacing.Top = 8 BorderSpacing.Top = 8
BorderSpacing.Right = 12 BorderSpacing.Right = 8
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
Caption = 'Return' Caption = 'Close'
ModalResult = 1 ModalResult = 11
OnClick = ReturnBtnClick OnClick = CloseBtnClick
TabOrder = 12 TabOrder = 11
end end
object Bevel1: TBevel object Bevel1: TBevel
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = Owner
AnchorSideRight.Control = Owner AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = ReturnBtn AnchorSideBottom.Control = CloseBtn
Left = 0 Left = 0
Height = 8 Height = 8
Top = 388 Top = 387
Width = 454 Width = 463
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
Shape = bsBottomLine Shape = bsBottomLine
end end
object OpenDialog1: TOpenDialog object OpenDialog1: TOpenDialog
left = 216 left = 64
top = 48 top = 72
end end
object SaveDialog1: TSaveDialog object SaveDialog1: TSaveDialog
left = 216 left = 56
top = 136 top = 168
end end
end end

View File

@ -17,9 +17,8 @@ type
Bevel1: TBevel; Bevel1: TBevel;
OpenDialog1: TOpenDialog; OpenDialog1: TOpenDialog;
ResetBtn: TButton; ResetBtn: TButton;
CancelBtn: TButton;
ComputeBtn: TButton; ComputeBtn: TButton;
ReturnBtn: TButton; CloseBtn: TButton;
InBtn: TBitBtn; InBtn: TBitBtn;
OutBtn: TBitBtn; OutBtn: TBitBtn;
AllBtn: TBitBtn; AllBtn: TBitBtn;
@ -40,7 +39,7 @@ type
Label1: TLabel; Label1: TLabel;
Label2: TLabel; Label2: TLabel;
Label3: TLabel; Label3: TLabel;
ListBox1: TListBox; SelList: TListBox;
VarList: TListBox; VarList: TListBox;
procedure AllBtnClick(Sender: TObject); procedure AllBtnClick(Sender: TObject);
procedure CancelBtnClick(Sender: TObject); procedure CancelBtnClick(Sender: TObject);
@ -53,10 +52,12 @@ type
procedure InBtnClick(Sender: TObject); procedure InBtnClick(Sender: TObject);
procedure OutBtnClick(Sender: TObject); procedure OutBtnClick(Sender: TObject);
procedure ResetBtnClick(Sender: TObject); procedure ResetBtnClick(Sender: TObject);
procedure ReturnBtnClick(Sender: TObject); procedure CloseBtnClick(Sender: TObject);
procedure VarListSelectionChange(Sender: TObject; User: boolean);
private private
{ private declarations } { private declarations }
FAutoSized: Boolean; FAutoSized: Boolean;
procedure UpdateBtnStates;
public public
{ public declarations } { public declarations }
end; end;
@ -69,16 +70,14 @@ implementation
{ TBackRegFrm } { TBackRegFrm }
procedure TBackRegFrm.ResetBtnClick(Sender: TObject); procedure TBackRegFrm.ResetBtnClick(Sender: TObject);
VAR i : integer; var
i: integer;
begin begin
VarList.Clear; VarList.Clear;
ListBox1.Clear; SelList.Clear;
for i := 1 to NoVariables do for i := 1 to NoVariables do
begin
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
end;
InBtn.Enabled := true;
OutBtn.Enabled := false;
CPChkBox.Checked := false; CPChkBox.Checked := false;
CovChkBox.Checked := false; CovChkBox.Checked := false;
CorrsChkBox.Checked := true; CorrsChkBox.Checked := true;
@ -89,11 +88,14 @@ begin
MatSaveChkBox.Checked := false; MatSaveChkBox.Checked := false;
PartialsChkBox.Checked := false; PartialsChkBox.Checked := false;
DepVar.Text := ''; DepVar.Text := '';
DepInBtn.Enabled := true;
DepOutBtn.Enabled := false;
end; end;
procedure TBackRegFrm.ReturnBtnClick(Sender: TObject); procedure TBackRegFrm.VarListSelectionChange(Sender: TObject; User: boolean);
begin
UpdateBtnStates;
end;
procedure TBackRegFrm.CloseBtnClick(Sender: TObject);
begin begin
Close; Close;
end; end;
@ -105,11 +107,10 @@ begin
if FAutoSized then if FAutoSized then
exit; exit;
w := MaxValue([ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]);
ResetBtn.Constraints.MinWidth := w; ResetBtn.Constraints.MinWidth := w;
CancelBtn.Constraints.MinWidth := w;
ComputeBtn.Constraints.MinWidth := w; ComputeBtn.Constraints.MinWidth := w;
ReturnBtn.Constraints.MinWidth := w; CloseBtn.Constraints.MinWidth := w;
Constraints.MinWidth := Width; Constraints.MinWidth := Width;
Constraints.MinHeight := Height; Constraints.MinHeight := Height;
@ -120,7 +121,6 @@ end;
procedure TBackRegFrm.FormCreate(Sender: TObject); procedure TBackRegFrm.FormCreate(Sender: TObject);
begin begin
Assert(OS3MainFrm <> nil); Assert(OS3MainFrm <> nil);
if OutputFrm = nil then Application.CreateForm(TOutputFrm, OutputFrm);
end; end;
procedure TBackRegFrm.FormShow(Sender: TObject); procedure TBackRegFrm.FormShow(Sender: TObject);
@ -129,14 +129,13 @@ begin
end; end;
procedure TBackRegFrm.AllBtnClick(Sender: TObject); procedure TBackRegFrm.AllBtnClick(Sender: TObject);
VAR count, index : integer; var
index: integer;
begin begin
count := VarList.Items.Count; for index := 0 to VarList.Items.Count-1 do
for index := 0 to count-1 do SelList.Items.Add(VarList.Items.Strings[index]);
begin
ListBox1.Items.Add(VarList.Items.Strings[index]);
end;
VarList.Clear; VarList.Clear;
UpdateBtnStates;
end; end;
procedure TBackRegFrm.CancelBtnClick(Sender: TObject); procedure TBackRegFrm.CancelBtnClick(Sender: TObject);
@ -145,8 +144,7 @@ begin
end; end;
procedure TBackRegFrm.ComputeBtnClick(Sender: TObject); procedure TBackRegFrm.ComputeBtnClick(Sender: TObject);
Label CleanUp; var
VAR
NoVars, NoIndepVars, i, j, NCases, StepNo : integer; NoVars, NoIndepVars, i, j, NCases, StepNo : integer;
Index: integer; Index: integer;
R2, determinant, stderrest, POut, LowestPartial : double; R2, determinant, stderrest, POut, LowestPartial : double;
@ -168,6 +166,7 @@ VAR
BetaWeights : DblDyneVec; BetaWeights : DblDyneVec;
IndepIndex : IntDyneVec; IndepIndex : IntDyneVec;
constant : double; constant : double;
lReport: TStrings;
begin begin
if NoVariables = 0 then NoVariables := 200; if NoVariables = 0 then NoVariables := 200;
SetLength(Corrs,NoVariables+1,NoVariables+1); SetLength(Corrs,NoVariables+1,NoVariables+1);
@ -183,44 +182,46 @@ begin
SetLength(IndepIndex,NoVariables); SetLength(IndepIndex,NoVariables);
SetLength(ColNoSelected,NoVariables); SetLength(ColNoSelected,NoVariables);
OutputFrm.RichEdit.Clear; lReport := TStringList.Create;
// OutputFrm.RichEdit.ParaGraph.Alignment := taLeftJustify; try
OutputFrm.RichEdit.Lines.Add('Step Backward Multiple Regression by Bill Miller'); lReport.Add('STEP BACKWARD MULTIPLE REGRESSION by Bill Miller');
errcode := false; errcode := false;
errorcode := 0; errorcode := 0;
if MatInChkBox.Checked = true then
if MatInChkBox.Checked then
begin begin
OpenDialog1.Filter := 'FreeStat matrix files (*.MAT)|*.MAT|All files (*.*)|*.*'; OpenDialog1.Filter := 'LazStats matrix files (*.mat)|*.mat;*.MAT|All files (*.*)|*.*';
OpenDialog1.FilterIndex := 1; OpenDialog1.FilterIndex := 1;
if OpenDialog1.Execute then if OpenDialog1.Execute then
begin begin
filename := OpenDialog1.FileName; 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 for i := 0 to NoVars-1 do
begin begin
Variances[i] := sqr(StdDevs[i]); Variances[i] := sqr(StdDevs[i]);
ColNoSelected[i] := i+1; ColNoSelected[i] := i+1;
end; end;
DepVar.Text := RowLabels[NoVars-1]; DepVar.Text := RowLabels[NoVars-1];
for i := 0 to NoVars-2 do ListBox1.Items.Add(RowLabels[i]); for i := 0 to NoVars-2 do SelList.Items.Add(RowLabels[i]);
CPChkBox.Checked := false; CPChkBox.Checked := false;
CovChkBox.Checked := false; CovChkBox.Checked := false;
MatSaveChkBox.Checked := false; MatSaveChkBox.Checked := false;
ShowMessage('NOTICE! Last variable in matrix is the dependent variable'); MessageDlg('Last variable in matrix is the dependent variable.', mtInformation, [mbOK], 0);
end; end;
end; end;
if MatInChkBox.Checked = false then
if not MatInChkBox.Checked then
begin begin
{ get variable columns } { get variable columns }
NoVars := ListBox1.Items.Count; NoVars := SelList.Items.Count;
if NoVars < 1 then if NoVars < 1 then
begin begin
ShowMessage('ERROR! No variables selected.'); MessageDlg('No variables selected.', mtError, [mbOK], 0);
goto CleanUp; exit;
end; end;
for i := 1 to NoVars do for i := 1 to NoVars do
begin begin
cellstring := ListBox1.Items.Strings[i-1]; cellstring := SelList.Items[i-1];
for j := 1 to NoVariables do for j := 1 to NoVariables do
begin begin
if cellstring = OS3MainFrm.DataGrid.Cells[j,0] then if cellstring = OS3MainFrm.DataGrid.Cells[j,0] then
@ -234,8 +235,8 @@ begin
{ get dependendent variable column } { get dependendent variable column }
if DepVar.Text = '' then if DepVar.Text = '' then
begin begin
ShowMessage('ERROR! No Dependent variable selected.'); MessageDlg('No Dependent variable selected.', mtError, [mbOK], 0);
goto CleanUp; exit;
end; end;
NoVars := NoVars + 1; NoVars := NoVars + 1;
for j := 1 to NoVariables do for j := 1 to NoVariables do
@ -248,58 +249,64 @@ begin
end; end;
end; end;
end; end;
POut := 1.0; POut := 1.0;
StepNo := 1; StepNo := 1;
while NoVars > 1 do while NoVars > 1 do
begin begin
OutputFrm.RichEdit.Lines.Add(''); if StepNo > 1 then
outline := format('----------------- STEP %3d ------------------',[StepNo]); lReport.Add('');
OutputFrm.RichEdit.Lines.Add(outline); lReport.Add('');
if CPChkBox.Checked = true then lReport.Add('----------------- STEP %3d ------------------', [StepNo]);
if CPChkBox.Checked then
begin begin
title := 'Cross-Products Matrix'; title := 'Cross-Products Matrix';
GridXProd(NoVars, ColNoSelected, Corrs, errcode, NCases); GridXProd(NoVars, ColNoSelected, Corrs, errcode, NCases);
MAT_PRINT(Corrs,NoVars,NoVars,title,RowLabels,ColLabels,NCases); MatPrint(Corrs, NoVars, NoVars, title, RowLabels, ColLabels, NCases, lReport);
end; end;
if CovChkBox.Checked = true then if CovChkBox.Checked then
begin begin
title := 'Variance-Covariance Matrix'; title := 'Variance-Covariance Matrix';
GridCovar(NoVars,ColNoSelected,Corrs,Means,Variances, GridCovar(NoVars, ColNoSelected, Corrs, Means, Variances, StdDevs, errcode, NCases);
StdDevs,errcode,NCases); MatPrint(Corrs, NoVars, NoVars, title, RowLabels, ColLabels, NCases, lReport);
MAT_PRINT(Corrs,NoVars,NoVars,title,RowLabels,ColLabels,NCases);
end; end;
if MatInChkBox.Checked = false then if not MatInChkBox.Checked then
Correlations(NoVars,ColNoSelected,Corrs,Means,Variances, Correlations(NoVars, ColNoSelected, Corrs, Means, Variances, StdDevs, errcode, NCases);
StdDevs,errcode,NCases); if CorrsChkBox.Checked then
if CorrsChkBox.Checked = true then
begin begin
title := 'Product-Moment Correlations Matrix'; title := 'Product-Moment Correlations Matrix';
MAT_PRINT(Corrs,NoVars,NoVars,title,RowLabels,ColLabels,NCases); MatPrint(Corrs, NoVars, NoVars, title, RowLabels, ColLabels, NCases, lReport);
end; end;
if MatSaveChkBox.Checked = true then if MatSaveChkBox.Checked then
begin begin
SaveDialog1.Filter := 'FreeStat matrix files (*.MAT)|*.MAT|All files (*.*)|*.*'; SaveDialog1.Filter := 'LazStats matrix files (*.mat)|*.mat;*.MAT|All files (*.*)|*.*';
SaveDialog1.FilterIndex := 1; SaveDialog1.FilterIndex := 1;
if SaveDialog1.Execute then if SaveDialog1.Execute then
begin begin
filename := SaveDialog1.FileName; 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;
MatSaveChkBox.Checked := false; // only save first one MatSaveChkBox.Checked := false; // only save first one
end; end;
if MeansChkBox.Checked then
begin
title := 'Means'; title := 'Means';
if MeansChkBox.Checked = true then DynVectorPrint(Means, NoVars, title, ColLabels, NCases, lReport);
DynVectorPrint(Means,NoVars,title,ColLabels,NCases); end;
if VarChkBox.Checked then
begin
title := 'Variances'; title := 'Variances';
if VarChkBox.Checked = true then DynVectorPrint(Variances, NoVars, title, ColLabels, NCases, lReport);
DynVectorPrint(Variances,NoVars,title,ColLabels,NCases); end;
if SDChkBox.Checked then
begin
title := 'Standard Deviations'; title := 'Standard Deviations';
if SDChkBox.Checked = true then DynVectorPrint(StdDevs, NoVars, title, ColLabels, NCases, lReport);
DynVectorPrint(StdDevs,NoVars,title,ColLabels,NCases); end;
if errorcode > 0 then if errorcode > 0 then
begin begin
ShowMessage('ERROR! A selected variable has no variability-run aborted.'); MessageDlg('A selected variable has no variability-run aborted.', mtError, [mbOK], 0);
goto CleanUp; exit;
end; end;
{ get determinant of the correlation matrix } { get determinant of the correlation matrix }
@ -310,17 +317,18 @@ begin
Determ(CorrMat, NoVars, NoVars, determinant, errcode); Determ(CorrMat, NoVars, NoVars, determinant, errcode);
if (determinant < 0.000001) then if (determinant < 0.000001) then
begin begin
ShowMessage('ERROR! Matrix is singular!'); MessageDlg('Matrix is singular!', mtError,[mbOK], 0);
// goto cleanup; // goto cleanup;
end; end;
outline := format('Determinant of correlation matrix = %8.4f',[determinant]); lReport.Add('Determinant of correlation matrix = %8.4f', [determinant]);
OutputFrm.RichEdit.Lines.Add(outline); lReport.Add('');
OutputFrm.RichEdit.Lines.Add('');
NoIndepVars := NoVars-1; NoIndepVars := NoVars-1;
for i := 1 to NoIndepVars do IndepIndex[i-1] := i; for i := 1 to NoIndepVars do IndepIndex[i-1] := i;
MReg2(NCases,NoVars,NoIndepVars,IndepIndex,corrs,InverseMat, MReg2(NCases,NoVars,NoIndepVars,IndepIndex,corrs,InverseMat,
RowLabels,R2,BetaWeights, RowLabels,R2,BetaWeights,
Means,Variances,errorcode,StdErrEst,constant,POut,true, false,false, OutputFrm.RichEdit.Lines); Means,Variances,errorcode,StdErrEst,constant,POut,true, false,false, lReport);
// Get partial correlation matrix // Get partial correlation matrix
for i := 1 to NoVars do for i := 1 to NoVars do
for j := 1 to NoVars do for j := 1 to NoVars do
@ -345,18 +353,16 @@ begin
Index := i; Index := i;
end; end;
end; end;
if PartialsChkBox.Checked = true then if PartialsChkBox.Checked then
begin begin
title := 'Partial Correlations'; title := 'Partial Correlations';
DynVectorPrint(BetaWeights,NoIndepVars,title,ColLabels,NCases); DynVectorPrint(BetaWeights, NoIndepVars, title, ColLabels, NCases, lReport);
end; end;
OutputFrm.ShowModal;
{ eliminate variable with lowest partial } { eliminate variable with lowest partial }
if NoVars > 2 then if NoVars > 2 then
begin begin
outline := format('Variable %d (%s) eliminated',[Index,ColLabels[Index-1]]); lReport.Add('Variable %d (%s) eliminated', [Index, ColLabels[Index-1]]);
OutputFrm.RichEdit.Lines.Add(outline);
for i := Index to NoVars-1 do for i := Index to NoVars-1 do
begin begin
ColNoSelected[i-1] := ColNoSelected[i]; ColNoSelected[i-1] := ColNoSelected[i];
@ -366,11 +372,15 @@ begin
NoVars := NoVars - 1; NoVars := NoVars - 1;
StepNo := StepNo + 1; StepNo := StepNo + 1;
end end
else NoVars := 0; else
NoVars := 0;
end; end;
OutputFrm.ShowModal;
CleanUp: DisplayReport(lReport);
finally
lReport.Free;
ColNoSelected := nil; ColNoSelected := nil;
IndepIndex := nil; IndepIndex := nil;
BetaWeights := nil; BetaWeights := nil;
@ -383,53 +393,97 @@ CleanUp:
Variances := nil; Variances := nil;
Means := nil; Means := nil;
Corrs := nil; Corrs := nil;
Close; end;
end; end;
procedure TBackRegFrm.DepInBtnClick(Sender: TObject); procedure TBackRegFrm.DepInBtnClick(Sender: TObject);
VAR index : integer; var
index: integer;
begin begin
index := ListBox1.ItemIndex; index := varList.ItemIndex;
DepVar.Text := ListBox1.Items.Strings[index]; if (index > -1) and (DepVar.Text = '') then
ListBox1.Items.Delete(index); begin
DepOutBtn.Enabled := true; DepVar.Text := VarList.Items[index];
DepInBtn.Enabled := false; VarList.Items.Delete(index);
end;
UpdateBtnStates;
end; end;
procedure TBackRegFrm.DepOutBtnClick(Sender: TObject); procedure TBackRegFrm.DepOutBtnClick(Sender: TObject);
begin begin
ListBox1.Items.Add(DepVar.Text); if DepVar.Text <> '' then
begin
SelList.Items.Add(DepVar.Text);
DepVar.Text := ''; DepVar.Text := '';
DepInBtn.Enabled := true; end;
UpdateBtnStates;
end; end;
procedure TBackRegFrm.InBtnClick(Sender: TObject); procedure TBackRegFrm.InBtnClick(Sender: TObject);
VAR i, index : integer; var
i: integer;
begin begin
index := VarList.Items.Count;
i := 0; i := 0;
while i < index do while i < VarList.Items.Count do
begin begin
if (VarList.Selected[i]) then if VarList.Selected[i] then
begin begin
ListBox1.Items.Add(VarList.Items.Strings[i]); SelList.Items.Add(VarList.Items[i]);
VarList.Items.Delete(i); VarList.Items.Delete(i);
index := index - 1;
i := 0; i := 0;
end end
else i := i + 1; else
i := i + 1;
end; end;
OutBtn.Enabled := true; UpdateBtnStates;
end; end;
procedure TBackRegFrm.OutBtnClick(Sender: TObject); procedure TBackRegFrm.OutBtnClick(Sender: TObject);
VAR index : integer; var
i: Integer;
begin begin
index := ListBox1.ItemIndex; i := 0;
VarList.Items.Add(ListBox1.Items.Strings[index]); while i < SelList.Items.Count do
ListBox1.Items.Delete(index); begin
InBtn.Enabled := true; if SelList.Selected[i] then
begin
VarList.Items.Add(SelList.Items[i]);
SelList.Items.Delete(i);
i := 0;
end
else
i := i + 1;
end; end;
UpdateBtnStates;
end;
procedure TBackRegFrm.UpdateBtnStates;
var
i: Integer;
lSelected: Boolean;
begin
lSelected := false;
for i := 0 to VarList.Items.Count-1 do
if VarList.Selected[i] then
begin
lSelected := true;
break;
end;
DepInBtn.Enabled := lSelected and (DepVar.Text = '');
InBtn.Enabled := lSelected;
DepOutBtn.Enabled := DepVar.Text <> '';
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 initialization
{$I backregunit.lrs} {$I backregunit.lrs}

View File

@ -29,7 +29,7 @@ object StepFwdFrm: TStepFwdFrm
AnchorSideTop.Control = InBtn AnchorSideTop.Control = InBtn
Left = 269 Left = 269
Height = 15 Height = 15
Top = 104 Top = 108
Width = 127 Width = 127
Caption = 'Variables to be Analyzed' Caption = 'Variables to be Analyzed'
ParentColor = False ParentColor = False
@ -39,7 +39,7 @@ object StepFwdFrm: TStepFwdFrm
AnchorSideBottom.Control = DepVar AnchorSideBottom.Control = DepVar
Left = 269 Left = 269
Height = 15 Height = 15
Top = 28 Top = 32
Width = 102 Width = 102
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 2 BorderSpacing.Bottom = 2
@ -73,7 +73,7 @@ object StepFwdFrm: TStepFwdFrm
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 224 Left = 224
Height = 28 Height = 28
Top = 104 Top = 108
Width = 28 Width = 28
BorderSpacing.Top = 24 BorderSpacing.Top = 24
Images = MainDataModule.ImageList Images = MainDataModule.ImageList
@ -89,7 +89,7 @@ object StepFwdFrm: TStepFwdFrm
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 224 Left = 224
Height = 28 Height = 28
Top = 136 Top = 140
Width = 28 Width = 28
BorderSpacing.Top = 4 BorderSpacing.Top = 4
Images = MainDataModule.ImageList Images = MainDataModule.ImageList
@ -105,7 +105,7 @@ object StepFwdFrm: TStepFwdFrm
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 215 Left = 215
Height = 25 Height = 25
Top = 188 Top = 192
Width = 46 Width = 46
AutoSize = True AutoSize = True
BorderSpacing.Top = 24 BorderSpacing.Top = 24
@ -123,8 +123,8 @@ object StepFwdFrm: TStepFwdFrm
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = GroupBox2 AnchorSideBottom.Control = GroupBox2
Left = 269 Left = 269
Height = 92 Height = 88
Top = 121 Top = 125
Width = 199 Width = 199
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 8 BorderSpacing.Left = 8
@ -154,8 +154,9 @@ object StepFwdFrm: TStepFwdFrm
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 224 Left = 224
Height = 28 Height = 28
Top = 52 Top = 56
Width = 28 Width = 28
BorderSpacing.Top = 4
Images = MainDataModule.ImageList Images = MainDataModule.ImageList
ImageIndex = 0 ImageIndex = 0
OnClick = DepOutBtnClick OnClick = DepOutBtnClick
@ -173,7 +174,7 @@ object StepFwdFrm: TStepFwdFrm
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 269 Left = 269
Height = 23 Height = 23
Top = 45 Top = 49
Width = 199 Width = 199
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 8 BorderSpacing.Left = 8

View File

@ -123,7 +123,6 @@ end;
procedure TStepFwdFrm.FormCreate(Sender: TObject); procedure TStepFwdFrm.FormCreate(Sender: TObject);
begin begin
Assert(OS3MainFrm <> nil); Assert(OS3MainFrm <> nil);
if OutputFrm = nil then Application.CreateForm(TOutputFrm, OutputFrm);
end; end;
procedure TStepFwdFrm.FormShow(Sender: TObject); procedure TStepFwdFrm.FormShow(Sender: TObject);

View File

@ -46,10 +46,10 @@ procedure nonsymroots(a : DblDyneMat; nv : integer;
var t : double; var t : double;
var ev : double); var ev : double);
PROCEDURE ludcmp(VAR a: DblDyneMat; n: integer; VAR indx: IntDyneVec; VAR d: double); procedure ludcmp(const a: DblDyneMat; n: integer; const indx: IntDyneVec; out d: double);
procedure DETERM(VAR a : DblDyneMat; rows, cols : integer; VAR determ : double; procedure DETERM(const a: DblDyneMat; Rows, Cols: integer;
VAR errorcode : boolean); out determ: double; out errorcode: boolean);
procedure EffectCode(GridCol, min, max : integer; procedure EffectCode(GridCol, min, max : integer;
FactLetter : string; FactLetter : string;
@ -522,81 +522,103 @@ begin
end; { of procedure nonsymroots } end; { of procedure nonsymroots }
//------------------------------------------------------------------- //-------------------------------------------------------------------
PROCEDURE ludcmp(VAR a: DblDyneMat; n: integer; VAR indx: IntDyneVec; VAR d: double); PROCEDURE ludcmp(const a: DblDyneMat; n: integer; const indx: IntDyneVec; out d: double);
CONST tiny=1.0e-20; const
VAR k,j,imax,i: integer; tiny = 1.0e-20;
var
k,j,imax,i: integer;
sum,dum,big: double; sum,dum,big: double;
vv: DblDyneVec; vv: DblDyneVec;
BEGIN BEGIN
SetLength(vv,n); SetLength(vv,n);
d := 1.0; imax := 0; d := 1.0;
FOR i := 1 to n DO BEGIN imax := 0;
for i := 1 to n do begin
big := 0.0; big := 0.0;
FOR j := 1 to n DO IF (abs(a[i-1,j-1]) > big) THEN big := abs(a[i-1,j-1]); for j := 1 to n do
IF (big = 0.0) THEN BEGIN if (abs(a[i-1,j-1]) > big) then big := abs(a[i-1,j-1]);
ShowMessage('Singular matrix in Lower-Upper Decomposition routine'); if (big = 0.0) then
begin
MessageDlg('Singular matrix in Lower-Upper Decomposition routine', mtError, [mbOK], 0);
exit; exit;
END; end;
vv[i-1] := 1.0/big vv[i-1] := 1.0/big;
END; end;
FOR j := 1 to n DO BEGIN
IF (j > 1) THEN BEGIN for j := 1 to n do
FOR i := 1 to j-1 DO BEGIN begin
if (j > 1) then
begin
for i := 1 to j-1 do
begin
sum := a[i-1,j-1]; sum := a[i-1,j-1];
IF (i > 1) THEN BEGIN if (i > 1) then
FOR k := 1 to i-1 DO BEGIN begin
sum := sum - a[i-1,k-1] * a[k-1,j-1] for k := 1 to i-1 do
END; sum := sum - a[i-1,k-1] * a[k-1,j-1];
a[i-1,j-1] := sum a[i-1,j-1] := sum
END end;
END end;
END; end;
big := 0.0; big := 0.0;
FOR i := j to n DO BEGIN for i := j to n do
begin
sum := a[i-1,j-1]; sum := a[i-1,j-1];
IF (j > 1) THEN BEGIN if (j > 1) then
FOR k := 1 to j-1 DO BEGIN begin
sum := sum - a[i-1,k-1] * a[k-1,j-1] for k := 1 to j-1 do
END; sum := sum - a[i-1,k-1] * a[k-1,j-1];
a[i-1,j-1] := sum a[i-1,j-1] := sum
END; END;
dum := vv[i-1] * abs(sum); dum := vv[i-1] * abs(sum);
IF (dum > big) THEN BEGIN if (dum > big) then
begin
big := dum; big := dum;
imax := i imax := i
END end;
END; end;
IF (j <> imax) THEN BEGIN
FOR k := 1 to n DO BEGIN if (j <> imax) then
begin
for k := 1 to n do
begin
dum := a[imax-1,k-1]; dum := a[imax-1,k-1];
a[imax-1,k-1] := a[j-1,k-1]; a[imax-1,k-1] := a[j-1,k-1];
a[j-1,k-1] := dum a[j-1,k-1] := dum;
END; end;
d := -d; d := -d;
vv[imax-1] := vv[j-1] vv[imax-1] := vv[j-1]
END; end;
indx[j-1] := imax; indx[j-1] := imax;
IF (j <> n) THEN BEGIN if (j <> n) then
IF (a[j-1,j-1] = 0.0) THEN a[j-1,j-1] := tiny; begin
if (a[j-1,j-1] = 0.0) then
a[j-1,j-1] := tiny;
dum := 1.0/a[j-1,j-1]; dum := 1.0/a[j-1,j-1];
FOR i := j+1 to n DO BEGIN for i := j+1 to n do
a[i-1,j-1] := a[i-1,j-1] * dum a[i-1,j-1] := a[i-1,j-1] * dum;
END end;
END end;
END;
IF (a[n-1,n-1] = 0.0) THEN a[n-1,n-1] := tiny; if (a[n-1,n-1] = 0.0) then
a[n-1,n-1] := tiny;
vv := nil; vv := nil;
END; end;
//------------------------------------------------------------------- //-------------------------------------------------------------------
procedure DETERM(VAR a : DblDyneMat; rows, cols : integer; VAR determ : double; procedure DETERM(const a: DblDyneMat; Rows, Cols: integer; out determ: double;
VAR errorcode : boolean); out errorcode: boolean);
var indx : IntDyneVec; var
indx: IntDyneVec;
i: integer; i: integer;
begin begin
SetLength(indx,rows); SetLength(indx,rows);
errorcode := FALSE; errorcode := false;
if (rows <> cols) then errorcode := TRUE else if (rows <> cols) then
errorcode := true
else
begin begin
LUDCMP(a, rows, indx, determ); LUDCMP(a, rows, indx, determ);
for i := 1 to rows do for i := 1 to rows do
@ -1362,6 +1384,7 @@ begin
MessageDlg('Error in computing variance estimate.', mtError, [mbOK], 0); MessageDlg('Error in computing variance estimate.', mtError, [mbOK], 0);
StdErrEst := 0.0; StdErrEst := 0.0;
end; end;
if (R2 < 1.0) and (df2 > 0.0) and (df1 > 0.0) then if (R2 < 1.0) and (df2 > 0.0) and (df1 > 0.0) then
F := (R2 / df1) / ((1.0-R2)/ df2) F := (R2 / df1) / ((1.0-R2)/ df2)
else else