pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity
Files
b98f47bf19a2b896f78f7fc9cbeabd9a38d6e520
lazarus-ccr/applications/lazstats/source/forms/analysis/multiple_regression/twoslsunit.pas
wp_xxyyzz aac25fbe8d LazStats: Less hints and warnings 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7829 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2020-10-29 22:48:02 +00:00

653 lines
19 KiB
ObjectPascal
Raw Blame History

// File for testing: "cansas.laz"
// - dependent variable: jumpgs
// - exolanatory variables: pulse, chins, situps
// - InstrumentalList variables: pulse, chins, situps, weight, waist
unit TwoSLSUnit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
StdCtrls, Buttons, ExtCtrls, math,
Globals, MainUnit, MainDM, MatrixLib, DictionaryUnit, BasicStatsReportFormUnit;
type
{ TTwoSLSForm }
TTwoSLSForm = class(TBasicStatsReportForm)
Bevel2: TBevel;
ProxyRegShowChk: TCheckBox;
SaveItChk: TCheckBox;
DepIn: TBitBtn;
DepOut: TBitBtn;
ExpIn: TBitBtn;
ExpOut: TBitBtn;
OptionsGroup: TGroupBox;
InstIn: TBitBtn;
InstOut: TBitBtn;
DepVarEdit: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
ExplanatoryList: TListBox;
InstrumentalList: TListBox;
VarList: TListBox;
procedure DepInClick(Sender: TObject);
procedure DepOutClick(Sender: TObject);
procedure ExpInClick(Sender: TObject);
procedure ExplanatoryListDblClick(Sender: TObject);
procedure ExplanatoryListSelectionChange(Sender: TObject; {%H-}User: boolean);
procedure ExpOutClick(Sender: TObject);
procedure InstInClick(Sender: TObject);
procedure InstOutClick(Sender: TObject);
procedure InstrumentalListDblClick(Sender: TObject);
procedure PredictIt(const ColNoSelected: IntDyneVec; NoVars: integer;
Means, StdDevs, BetaWeights : DblDyneVec;
StdErrEst : double; NoIndepVars : integer);
procedure VarListDblClick(Sender: TObject);
private
protected
procedure AdjustConstraints; override;
procedure Compute; override;
procedure UpdateBtnStates; override;
public
constructor Create(AOwner: TComponent); override;
procedure Reset; override;
end;
var
TwoSLSForm: TTwoSLSForm;
implementation
{$R *.lfm}
uses
StrUtils, Utils;
{ TTwoSLSForm }
constructor TTwoSLSForm.Create(AOwner: TComponent);
begin
inherited;
if DictionaryFrm = nil then Application.CreateForm(TDictionaryFrm, DictionaryFrm);
end;
procedure TTwoSLSForm.AdjustConstraints;
begin
inherited;
ParamsPanel.Constraints.MinWidth := Max(
4*CloseBtn.Width + 3*CloseBtn.BorderSpacing.Left,
OptionsGroup.Width);
ParamsPanel.Constraints.MinHeight := InstOut.Top + InstOut.Height +
VarList.BorderSpacing.Bottom + OptionsGroup.Height + ButtonBevel.Height +
CloseBtn.BorderSpacing.Top + CloseBtn.Height;
end;
procedure TTwoSLSForm.Compute;
var
IndepCols: IntDyneVec = nil;
ProxSrcCols: IntDyneVec = nil;
ExpCols: IntDyneVec = nil;
InstCols: IntDyneVec = nil;
ProxCols: IntDyneVec = nil;
ExpLabels: StrDyneVec = nil;
InstLabels: StrDyneVec = nil;
ProxLabels: StrDyneVec = nil;
RowLabels: StrDyneVec = nil;
ProxSrcLabels: StrDyneVec = nil;
Means: DblDyneVec = nil;
Variances: DblDyneVec = nil;
StdDevs: DblDyneVec = nil;
BWeights: DblDyneVec = nil;
BetaWeights: DblDyneVec = nil;
BStdErrs: DblDyneVec = nil;
Bttests: DblDyneVec = nil;
tProbs: DblDyneVec = nil;
R2: Double = 0.0;
stdErrEst: Double = 0.0;
i, j, k, DepCol, NoInst, NoExp, NoProx, Noindep : integer;
DepProx, NCases, col, counter : integer;
X, Y : double;
// ProxVals : DblDyneMat;
PrintDesc: Boolean;
// PrintCorrs, PrintInverse, PrintCoefs, SaveCorrs : boolean;
found : boolean;
lReport: TStrings;
errorcode: Boolean = false;
begin
if DepVarEdit.Text = '' then
begin
MessageDlg('Dependent variable not selected.', mtError, [mbOK], 0);
exit;
end;
if ExplanatoryList.Items.Count = 0 then
begin
MessageDlg('No explanatory variables selected.', mtError, [mbOK], 0);
exit;
end;
if InstrumentalList.Items.Count = 0 then
begin
MessageDlg('No instrumental variables selected.', mtError, [mbOK], 0);
exit;
end;
if (ProxyRegShowChk.Checked) then
begin
PrintDesc := true;
// PrintCorrs := true;
// PrintInverse := false;
// PrintCoefs := true;
// SaveCorrs := false;
end
else
begin
PrintDesc := false;
// PrintCorrs := false;
// PrintInverse := false;
// PrintCoefs := false;
// SaveCorrs := false;
end;
SetLength(Means,NoVariables+2);
SetLength(Variances,NoVariables+2);
SetLength(StdDevs,NoVariables+2);
SetLength(BWeights,NoVariables+2);
SetLength(BetaWeights,NoVariables+2);
SetLength(BStdErrs,NoVariables+2);
SetLength(Bttests,NoVariables+2);
SetLength(tprobs,NoVariables+2);
SetLength(ExpLabels,NoVariables+2);
SetLength(ExpCols,NoVariables+2);
SetLength(InstLabels,NoVariables+2);
SetLength(InstCols,NoVariables+2);
SetLength(ProxCols,NoVariables);
SetLength(ProxLabels,NoVariables);
SetLength(IndepCols,NoVariables);
SetLength(RowLabels,NoVariables);
SetLength(ProxSrcCols,NoVariables);
SetLength(ProxSrcLabels,NoVariables);
// SetLength(ProxVals,NoCases,NoVariables);
// Get variables to analyze
NCases := NoCases;
NoInst := InstrumentalList.Items.Count;
NoExp := ExplanatoryList.Items.Count;
if (NoInst < NoExp) then
begin
MessageDlg('The no. of Instrumental must equal or exceed the Explanatory', mtError, [mbOK], 0);
exit;
end;
for i := 0 to NoVariables - 1 do
begin
if (OS3MainFrm.DataGrid.Cells[i+1,0] = DepVarEdit.Text) then
begin
DepCol := i + 1;
// result := VarTypeChk(DepCol,0);
// if (result :=:= 1) goto cleanup;
end;
for j := 0 to NoExp - 1 do
begin
if (OS3MainFrm.DataGrid.Cells[i+1,0] = ExplanatoryList.Items.Strings[j]) then
begin
ExpCols[j] := i+1;
// result := VarTypeChk(i+1,0);
// if (result :=:= 1) goto cleanup;
ExpLabels[j] := ExplanatoryList.Items.Strings[j];
end;
end; // next j
for j := 0 to NoInst - 1 do
begin
if (OS3MainFrm.DataGrid.Cells[i+1,0] = InstrumentalList.Items.Strings[j]) then
begin
InstCols[j] := i+1;
// result := VarTypeChk(i+1,0);
// if (result :=:= 1) goto cleanup;
InstLabels[j] := InstrumentalList.Items.Strings[j];
end;
end; // next j
end; // next i
// Get prox variables which are the variables common to exp and inst lists
NoProx := 0;
for i := 0 to NoInst - 1 do
begin
for j := 0 to NoExp - 1 do
begin
if (ExpLabels[j] = InstLabels[i]) then
begin
ProxLabels[NoProx] := 'P_' + InstLabels[i];
ProxSrcLabels[NoProx] := InstLabels[i];
ProxCols[NoProx] := InstCols[i];
NoProx := NoProx + 1;
end;
end;
end;
lReport := TStringList.Create;
try
// Output Parameters of the Analysis
lReport.Add('FILE: ' + OS3MainFrm.FileNameEdit.Text);
lReport.Add('');
lReport.Add('Dependent: ' + DepVarEdit.Text);
lReport.Add('');
lReport.Add('Explanatory Variables:');
for i := 0 to NoExp - 1 do
lReport.Add(' ' + ExpLabels[i]);
lReport.Add('');
lReport.Add('Instrumental Variables:');
for i := 0 to NoInst - 1 do
lReport.Add(' ' + InstLabels[i]);
lReport.Add('');
lReport.Add('Proxy Variables:');
for i := 0 to NoProx - 1 do
lReport.Add(' ' + ProxLabels[i]);
lReport.Add('');
// Compute the prox regressions for the InstrumentalList variables
for i := 0 to NoProx - 1 do
begin
DictionaryFrm.DictGrid.ColCount := 8;
col := NoVariables + 1;
// NoVariables := col;
DictionaryFrm.NewVar(col); // create column for proxy (predicted values)
DictionaryFrm.DictGrid.Cells[1,col] := ProxLabels[i];
OS3MainFrm.DataGrid.Cells[col,0] := ProxLabels[i];
ProxSrcCols[i] := col;
DepProx := ProxCols[i];
Noindep := 0;
for j := 0 to NoInst - 1 do
begin
if (DepProx <> InstCols[j]) then // don't include the prox itself!
begin
IndepCols[Noindep] := InstCols[j];
RowLabels[Noindep] := InstLabels[j];
Noindep := Noindep + 1;
end;
end;
for j := 0 to NoExp - 1 do
begin
found := false;
for k := 0 to NoProx - 1 do
if (ExpCols[j] = ProxCols[k]) then found := true; // don't include the proxs themselves
if (not found) then
begin
IndepCols[Noindep] := ExpCols[j];
RowLabels[Noindep] := ExpLabels[j];
Noindep := Noindep + 1;
end;
end;
IndepCols[Noindep] := DepProx;
lReport.Add('');
lReport.Add('==================================================================');
lReport.Add('');
lReport.Add('Analysis for ' + ProxLabels[i]);
lReport.Add('-------------' + DupeString('-', Length(ProxLabels[i])));
lReport.Add('Dependent: ' + ProxSrcLabels[i]);
lReport.Add('');
lReport.Add('Independent: ');
for j := 0 to Noindep - 1 do
lReport.Add(' ' + RowLabels[j]);
lReport.Add('');
// OutputFrm.ShowModal();
MReg(Noindep, IndepCols, DepProx, RowLabels, Means, Variances, StdDevs,
BWeights, BetaWeights, BStdErrs, Bttests, tprobs, R2, stderrest,
NCases, errorcode, PrintDesc, lReport);
// save predicted scores at column := NoVariables and in ProxVals array
for j := 1 to NoCases do
begin
Y := 0.0;
for k := 0 to Noindep - 1 do
begin
col := IndepCols[k];
X := StrToFloat(OS3MainFrm.DataGrid.Cells[col,j]);
Y := Y + BWeights[k] * X;
end;
Y := Y + BWeights[Noindep]; // intercept
col := NoVariables;
OS3MainFrm.DataGrid.Cells[col,j] := Format('%12.5f', [Y]);
end; // next case
end; // next proxy
// OutputFrm.ShowModal();
lReport.Add('');
lReport.Add('==================================================================');
lReport.Add('');
// Compute the OLS using the Prox values and ExplanatoryList
Noindep := 0;
counter := 0;
for i := 0 to NoExp - 1 do
begin
for j := 0 to NoInst - 1 do
begin
if (ExpLabels[i] = InstLabels[j]) then // use proxy
begin
IndepCols[Noindep] := ProxSrcCols[counter];
RowLabels[Noindep] := ProxLabels[counter];
counter := counter + 1;
break;
end
else
begin
IndepCols[Noindep] := ExpCols[i];
RowLabels[Noindep] := ExpLabels[i];
end;
end;
Noindep := Noindep + 1;
end;
PrintDesc := true;
// PrintCorrs := true;
// PrintInverse := false;
// PrintCoefs := true;
// SaveCorrs := false;
IndepCols[Noindep] := DepCol;
MReg(Noindep, IndepCols, DepCol, RowLabels, Means, Variances, StdDevs,
BWeights, BetaWeights, BStdErrs, Bttests, tprobs, R2, stderrest,
NCases, errorcode, PrintDesc, lReport);
FReportFrame.DisplayReport(lReport);
if SaveItChk.Checked then
PredictIt(IndepCols, Noindep+1, Means, StdDevs, BetaWeights, stderrest, Noindep);
finally
lReport.Free;
end;
end;
procedure TTwoSLSForm.DepInClick(Sender: TObject);
var
index: integer;
begin
index := VarList.ItemIndex;
if (index > -1) and (DepVarEdit.Text = '') then
begin
DepVarEdit.Text := VarList.Items[index];
VarList.Items.Delete(index);
end;
UpdateBtnStates;
end;
procedure TTwoSLSForm.DepOutClick(Sender: TObject);
begin
if DepVarEdit.Text <> '' then
begin
VarList.Items.Add(DepVarEdit.Text);
DepVarEdit.Text := '';
end;
UpdateBtnStates;
end;
procedure TTwoSLSForm.ExpInClick(Sender: TObject);
var
i: integer;
begin
i := 0;
while (i < VarList.Items.Count) do
begin
if VarList.Selected[i] and (ExplanatoryList.Items.IndexOf(VarList.Items[i]) = -1) then
ExplanatoryList.Items.Add(VarList.Items[i]);
// DO NOT DELETE Items HERE.
i := i + 1;
end;
UpdateBtnStates;
end;
procedure TTwoSLSForm.ExplanatoryListDblClick(Sender: TObject);
var
index: Integer;
begin
index := ExplanatoryList.ItemIndex;
if index > -1 then
begin
VarList.Items.Add(ExplanatoryList.Items[index]);
ExplanatoryList.Items.Delete(index);
UpdateBtnStates;
end;
end;
procedure TTwoSLSForm.ExplanatoryListSelectionChange(Sender: TObject; User: boolean);
begin
UpdateBtnStates;
end;
procedure TTwoSLSForm.ExpOutClick(Sender: TObject);
var
i: Integer;
begin
i := 0;
while (i < ExplanatoryList.Items.Count) do
begin
if ExplanatoryList.Selected[i] then
begin
if (VarList.Items.IndexOf(ExplanatoryList.Items[i]) = -1) then
VarList.Items.Add(ExplanatoryList.Items[i]);
ExplanatoryList.Items.Delete(i);
i := 0;
end else
i := i + 1;
end;
UpdateBtnStates;
end;
procedure TTwoSLSForm.InstInClick(Sender: TObject);
var
i: integer;
begin
i := 0;
while (i < VarList.Items.Count) do
begin
if VarList.Selected[i] and (InstrumentalList.Items.IndexOf(VarList.Items[i]) = -1) then
InstrumentalList.Items.Add(VarList.Items[i])
// DO NOT DELETE Items HERE.
else
i := i + 1;
end;
UpdateBtnStates;
end;
procedure TTwoSLSForm.InstOutClick(Sender: TObject);
var
i: Integer;
begin
i := 0;
while (i < InstrumentalList.Items.Count) do
begin
if InstrumentalList.Selected[i] then
begin
if VarList.Items.IndexOf(InstrumentalList.Items[i]) = -1 then
VarList.Items.Add(InstrumentalList.Items[i]);
InstrumentalList.Items.Delete(i);
i := 0;
end else
i := i + 1;
end;
UpdateBtnStates;
end;
procedure TTwoSLSForm.InstrumentalListDblClick(Sender: TObject);
var
index: Integer;
begin
index := InstrumentalList.ItemIndex;
if index > -1 then
begin
VarList.Items.Add(InstrumentalList.Items[index]);
InstrumentalList.Items.Delete(index);
UpdateBtnStates;
end;
end;
procedure TTwoSLSForm.PredictIt(const ColNoSelected: IntDyneVec; NoVars: integer;
Means, StdDevs, BetaWeights: DblDyneVec;
StdErrEst: double; NoIndepVars: integer);
var
col, i, j, k, Index: integer;
predicted, zpredicted, z1, z2, resid, residsqr: double;
astring: string;
begin
// routine obtains predicted raw and standardized scores and their
// residuals. It is assumed that the dependent variable is last in the
// list of variable column pointers stored in the ColNoSelected vector.
// Get the z predicted score and its residual
col := NoVariables + 1;
// NoVariables := col;
DictionaryFrm.NewVar(col);
DictionaryFrm.DictGrid.Cells[1,col] := 'Pred.z';
OS3MainFrm.DataGrid.Cells[col,0] := 'Pred.z';
col := NoVariables + 1;
// NoVariables := col;
DictionaryFrm.NewVar(col);
DictionaryFrm.DictGrid.Cells[1,col] := 'zResid.';
OS3MainFrm.DataGrid.Cells[col,0] := 'zResid.';
// OS3MainFrm.DataGrid.ColCount := OS3MainFrm.DataGrid.ColCount + 2;
for i := 1 to NoCases do
begin
zpredicted := 0.0;
for j := 0 to NoIndepVars - 1 do
begin
k := ColNoSelected[j];
z1 := (StrToFloat(OS3MainFrm.DataGrid.Cells[k,i]) -
Means[j]) / StdDevs[j];
zpredicted := zpredicted + (z1 * BetaWeights[j]);
end;
astring := format('%8.4f',[zpredicted]);
OS3MainFrm.DataGrid.Cells[col-1,i] := astring;
Index := ColNoSelected[NoVars-1];
z2 := StrToFloat(OS3MainFrm.DataGrid.Cells[Index,i]);
z2 := (z2 - Means[NoVars-1]) / StdDevs[NoVars-1]; // z score
astring := format('%8.4f',[z2 - zpredicted]); // z residual
OS3MainFrm.DataGrid.Cells[col,i] := astring;
end;
// Get raw predicted and residuals
col := NoVariables + 1;
// NoVariables := col;
DictionaryFrm.NewVar(col);
DictionaryFrm.DictGrid.Cells[1,col] := 'Pred.Raw';
OS3MainFrm.DataGrid.Cells[col,0] := 'Pred.Raw';
// calculate raw predicted scores and store in grid at col
for i := 1 to NoCases do
begin // predicted raw obtained from previously predicted z score
predicted := StrToFloat(OS3MainFrm.DataGrid.Cells[col-2,i]) *
StdDevs[NoVars-1] + Means[NoVars-1];
astring := format('%8.3f',[predicted]);
OS3MainFrm.DataGrid.Cells[col,i] := astring;
end;
// Calculate residuals of predicted raw scores begin
col := NoVariables +1;
// NoVariables := col;
DictionaryFrm.NewVar(col);
DictionaryFrm.DictGrid.Cells[1,col] := 'RawResid.';
OS3MainFrm.DataGrid.Cells[col,0] := 'RawResid.';
for i := 1 to NoCases do
begin
Index := ColNoSelected[NoVars-1];
resid := StrToFloat(OS3MainFrm.DataGrid.Cells[col-1,i]) -
StrToFloat(OS3MainFrm.DataGrid.Cells[Index,i]);
astring := format('%8.3f',[resid]);
OS3MainFrm.DataGrid.Cells[col,i] := astring;
end;
// get square of raw residuals
col := NoVariables + 1;
// NoVariables := col;
DictionaryFrm.NewVar(col);
DictionaryFrm.DictGrid.Cells[1,col] := 'ResidSqr';
OS3MainFrm.DataGrid.Cells[col,0] := 'ResidSqr';
for i := 1 to NoCases do
begin
residsqr := StrToFloat(OS3MainFrm.DataGrid.Cells[col-1,i]);
residsqr := residsqr * residsqr;
astring := format('%8.3f',[residsqr]);
OS3MainFrm.DataGrid.Cells[col,i] := astring;
end;
end;
procedure TTwoSLSForm.Reset;
var
i: integer;
begin
inherited;
DepVarEdit.Clear;
InstrumentalList.Clear;
ExplanatoryList.Clear;
VarList.Clear;
for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
ProxyRegShowChk.Checked := false;
UpdateBtnStates;
end;
procedure TTwoSLSForm.UpdateBtnStates;
var
lSelected: Boolean;
begin
inherited;
lSelected := AnySelected(VarList);
DepIn.Enabled := lSelected and (DepVarEdit.Text = '');
ExpIn.Enabled := lSelected;
InstIn.Enabled := lSelected;
DepOut.Enabled := (DepVarEdit.Text <> '');
ExpOut.Enabled := AnySelected(ExplanatoryList);
InstOut.Enabled := AnySelected(InstrumentalList);
end;
procedure TTwoSLSForm.VarListDblClick(Sender: TObject);
var
index: Integer;
begin
index := VarList.ItemIndex;
if index > -1 then
begin
if DepVarEdit.Text = '' then
DepVarEdit.Text := VarList.Items[index]
else
ExplanatoryList.Items.Add(VarList.Items[index]);
VarList.Items.Delete(index);
UpdateBtnStates;
end;
end;
end.
Reference in New Issue View Git Blame Copy Permalink