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

StepFwdMRUnit, BackRegUnit: like the others.

Browse Source 
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
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.

197
applications/lazstats/source/forms/analysis/multiple_regression/backregunit.lfm
View File

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

388
applications/lazstats/source/forms/analysis/multiple_regression/backregunit.pas
View File

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

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

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

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

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

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

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