// 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.