unit BlkMRegUnit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, Buttons, Globals, MainUnit, MatrixLib, OutPutUnit,
  FunctionsLib, DataProcs, DictionaryUnit;


type

  { TBlkMregFrm }

  TBlkMregFrm = class(TForm)
    ResetBtn: TButton;
    CancelBtn: TButton;
    ComputeBtn: TButton;
    ReturnBtn: TButton;
    CPChkBox: TCheckBox;
    CovChkBox: TCheckBox;
    CorrsChkBox: TCheckBox;
    MeansChkBox: TCheckBox;
    SaveDialog1: TSaveDialog;
    VarChkBox: TCheckBox;
    SDChkBox: TCheckBox;
    MatSaveChkBox: TCheckBox;
    PredictChkBox: TCheckBox;
    GroupBox1: TGroupBox;
    InProb: TEdit;
    Label5: TLabel;
    NextBlkBtn: TButton;
    DepInBtn: TBitBtn;
    DepOutBtn: TBitBtn;
    BlockNoEdit: TEdit;
    InBtn: TBitBtn;
    Label4: TLabel;
    OutBtn: TBitBtn;
    AllBtn: TBitBtn;
    DepVar: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    BlockList: TListBox;
    VarList: TListBox;
    procedure AllBtnClick(Sender: TObject);
    procedure CancelBtnClick(Sender: TObject);
    procedure ComputeBtnClick(Sender: TObject);
    procedure DepInBtnClick(Sender: TObject);
    procedure DepOutBtnClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure InBtnClick(Sender: TObject);
    procedure NextBlkBtnClick(Sender: TObject);
    procedure OutBtnClick(Sender: TObject);
    procedure ResetBtnClick(Sender: TObject);
  private
    { private declarations }
   BlkVarCols : IntDyneMat;
   NoBlocks : integer;
   VarsInBlk : IntDyneVec;
   NoVars : integer;

  public
    { public declarations }
  end; 

var
  BlkMregFrm: TBlkMregFrm;

implementation

{ TBlkMregFrm }

procedure TBlkMregFrm.ResetBtnClick(Sender: TObject);
VAR i : integer;
begin
     BlockList.Items.Clear;
     VarList.Items.Clear;
     BlockNoEdit.Text := '1';
     NoBlocks := 1;
     for i := 1 to NoVariables do
     begin
          VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
     end;
     InBtn.Enabled := true;
     OutBtn.Enabled := false;
     DepInBtn.Enabled := true;
     DepOutBtn.Enabled := false;
     CPChkBox.Checked := false;
     CovChkBox.Checked := false;
     CorrsChkBox.Checked := true;
     MeansChkBox.Checked := true;
     VarChkBox.Checked := false;
     SDChkBox.Checked := true;
     MatSaveChkBox.Checked := false;
     PredictChkBox.Checked := false;
//     HeteroChk.Checked := false;
     NoVars := 0;
     DepVar.Text := '';
     InProb.Text := '0.05';
     SetLength(BlkVarCols,NoVariables,NoVariables);
     SetLength(VarsInBlk,NoVariables);
end;

procedure TBlkMregFrm.FormShow(Sender: TObject);
begin
     ResetBtnClick(self);
end;

procedure TBlkMregFrm.AllBtnClick(Sender: TObject);
VAR count, index : integer;
begin
     count := VarList.Items.Count;
     for index := 0 to count-1 do
     begin
          BlockList.Items.Add(VarList.Items.Strings[index]);
     end;
     VarList.Clear;
end;

procedure TBlkMregFrm.CancelBtnClick(Sender: TObject);
begin
     if VarsInBlk <> nil then VarsInBlk := nil;
     if BlkVarCols <> nil then BlkVarCols := nil;
     BlkMRegFrm.Hide;
end;

procedure TBlkMregFrm.ComputeBtnClick(Sender: TObject);
Label CleanUp;
var
   i, j, k, col, mattype, errorcode, NCases : integer;
   NoIndepVars, DepVarCol, NEntered, StepNo : integer;
   R2, df1, df2, Y, z, BPG, chiprob : double;
   StdErrEst, F, FProbF, OldR2 : double;
   pdf1, pdf2, probin, prout : double;
   BetaWeights : DblDyneVec;
   cellstring, outline : string;
   corrs : DblDyneMat;
   Means : DblDyneVec;
   Variances : DblDyneVec;
   StdDevs : DblDyneVec;
   title : string;
   IndRowLabels : StrDyneVec;
   IndColLabels : StrDyneVec;
   IndepInverse : DblDyneMat;
   IndepIndex : IntDyneVec;
   XYCorrs : DblDyneVec;
   Partial : DblDyneVec;
   Candidate : IntDyneVec;
   filename : string;
   ColEntered : IntDyneVec;
   constant : double;
   errcode : boolean;
begin
     SetLength(corrs,NoVariables+1,NoVariables+1);
     SetLength(IndepInverse,NoVariables,NoVariables);
     SetLength(Means,NoVariables);
     SetLength(Variances,NoVariables);
     SetLength(StdDevs,NoVariables);
     SetLength(IndepIndex,NoVariables);
     SetLength(IndColLabels,NoVariables);
     SetLength(IndRowLabels,NoVariables);
     SetLength(BetaWeights,NoVariables);
     SetLength(Candidate,NoVariables);
     SetLength(ColEntered,NoVariables);

     NextBlkBtnClick(self);
     probin := StrToFloat(InProb.Text); // probability to include a block
     prout := 1.0;
     OutPutFrm.RichEdit.Clear;
//     OutPutFrm.RichEdit.ParaGraph.Alignment := taLeftJustify;
     OutPutFrm.RichEdit.Lines.Add('Block Entry Multiple Regression by Bill Miller');
     errorcode := 0;

     { get dependendent variable column }
     if DepVar.Text = '' then
     begin
          ShowMessage('ERROR! No Dependent variable selected.');
          goto CleanUp;
     end;
     DepVarCol := 0;
     NoVars := NoVars + 1;
     for j := 1 to NoVariables do
          if DepVar.Text = OS3MainFrm.DataGrid.Cells[j,0] then DepVarCol := j;
     R2 := 0.0;
     OldR2 := 0.0;
     pdf1 := 0.0;
     pdf2 := 0.0;
     for i := 1 to NoBlocks-1 do Candidate[i-1] := i;
     { Now, complete Mult. Regs by adding blocks in each step }
     for StepNo := 1 to NoBlocks-1 do
     begin
          NEntered := 0;
          for i := 1 to StepNo do
          begin
               if (Candidate[StepNo-1] <> 0) then
               begin
                    for j := 1 to VarsInBlk[i-1] do
                    begin
                         NEntered := NEntered + 1;
                         ColEntered[NEntered-1] := BlkVarCols[i-1,j-1];
                         k := BlkVarCols[i-1,j-1];
                         IndRowLabels[NEntered-1] := OS3MainFrm.DataGrid.Cells[k,0];
                         IndColLabels[NEntered-1] := OS3MainFrm.DataGrid.Cells[k,0];
                    end;
               end;
          end;
          NEntered := NEntered + 1; // dependent variable last
          ColEntered[NEntered-1] := DepVarCol;
          IndRowLabels[NEntered-1] := OS3MainFrm.DataGrid.Cells[DepVarCol,0];
          IndColLabels[NEntered-1] := OS3MainFrm.DataGrid.Cells[DepVarCol,0];
          OutPutFrm.RichEdit.Lines.Add('');
          outline := format('----------------- Trial Block %d Variables Added ------------------',[StepNo]);
          OutPutFrm.RichEdit.Lines.Add(outline);
          if CPChkBox.Checked = true then
          begin
               title := 'Cross-Products Matrix';
               GridXProd(NEntered,ColEntered,Corrs,errcode,NCases);
               MAT_PRINT(Corrs,NEntered,NEntered,title,IndRowLabels,IndColLabels,NCases);
          end;
          if CovChkBox.Checked = true then
          begin
               title := 'Variance-Covariance Matrix';
               GridCovar(NEntered,ColEntered,Corrs,Means,Variances,
                      StdDevs,errcode,NCases);
               MAT_PRINT(Corrs,NEntered,NEntered,title,IndRowLabels,IndColLabels,NCases);
          end;
          Correlations(NEntered,ColEntered,Corrs,Means,Variances,
                    StdDevs,errcode,NCases);
          if CorrsChkBox.Checked = true then
          begin
               title := 'Product-Moment Correlations Matrix';
               MAT_PRINT(Corrs,NEntered,NEntered,title,IndRowLabels,IndColLabels,NCases);
          end;
          title := 'Means';
          if MeansChkBox.Checked = true then
             DynVectorPrint(Means,NEntered,title,IndColLabels,NCases);
          title := 'Variances';
          if VarChkBox.Checked = true then
             DynVectorPrint(Variances,NEntered,title,IndColLabels,NCases);
          title := 'Standard Deviations';
          if SDChkBox.Checked = true then
             DynVectorPrint(StdDevs,NEntered,title,IndColLabels,NCases);
          if errorcode > 0 then
          begin
               ShowMessage('ERROR! A selected variable has no variability-run aborted.');
               goto CleanUp;
          end;
          NoIndepVars := NEntered - 1;
          for i := 1 to NoIndepVars do IndepIndex[i-1] := i;
          MReg2(NCases,NEntered,NoIndepVars,IndepIndex,corrs,IndepInverse,
               IndRowLabels,R2,BetaWeights,
               Means,Variances,errorcode,StdErrEst,constant,prout,true, false,false);
          outline := format('Increase in R Squared = %6.3f',[R2-OldR2]);
          OutPutFrm.RichEdit.Lines.Add(outline);
          df1 := NoIndepVars - pdf1;
          df2 := NCases - NoIndepVars - 1;
          F := ((R2 - OldR2) / (1.0 - R2)) * df2 / df1;
          FProbF := probf(F,df1,df2);
          outline := format('F = %6.3f with probability = %6.3f',[F,FProbF]);
          OutPutFrm.RichEdit.Lines.Add(outline);
          if FProbF < probin then
          begin
               outline := format('Block %d met entry requirements',[StepNo]);
               OutPutFrm.RichEdit.Lines.Add(outline);
          end
          else
          begin
               Candidate[StepNo-1] := 0;
               NoIndepVars := NoIndepVars - VarsInBlk[StepNo-1];
               outline := format('Block %d did not meet entry requirements',[StepNo]);
               OutPutFrm.RichEdit.Lines.Add(outline);
          end;
          OldR2 := R2;
          pdf1 := NoIndepVars;
     end;

   { add [predicted scores, residual scores, etc. to grid if options elected }
   if PredictChkBox.Checked = true then
   begin
        prout := 1.0;
        Correlations(NEntered,ColEntered,Corrs,Means,Variances,
                    StdDevs,errcode,NCases);

        MReg2(NCases,NEntered,NoIndepVars,IndepIndex,corrs,IndepInverse,
                    IndRowLabels,R2,BetaWeights,
                    Means,Variances,errorcode,StdErrEst,constant,prout,true, false,false);

        Predict(ColEntered, NEntered, IndepInverse, Means, StdDevs,
                BetaWeights, StdErrEst, IndepIndex, NoIndepVars);
   end;

{   if HeteroChk.Checked = true then // do BPG test
   begin
        OutPutFrm.RichEdit.Lines.Add('');
        OutPutFrm.RichEdit.Lines.Add('=====================================================');
        OutPutFrm.RichEdit.Lines.Add('Breusch-Pagan-Godfrey Test of Heteroscedasticity');
        OutPutFrm.RichEdit.Lines.Add('=====================================================');
        OutPutFrm.RichEdit.Lines.Add('');
        OutPutFrm.RichEdit.Lines.Add('Auxiliary Regression');
        OutPutFrm.RichEdit.Lines.Add('');
        BPG := 0.0;
        col := NoVariables + 1;
        DictionaryFrm.NewVar(col);
        DictionaryFrm.DictGrid.Cells[1,col] := 'BPGResid.';
        OS3MainFrm.DataGrid.Cells[col,0] := 'BPGResid.';
        NoVariables := NoVariables + 1;
        // get predicted raw score
        for i := 1 to NCases do
        begin
             Y := 0.0;
             for j := 1 to NoIndepVars do
             begin
                  col := IndepIndex[j-1];
                  k := ColEntered[col-1];
                  z := (StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[k,i])) -
                               Means[col-1]) / StdDevs[col-1];
                  Y := Y + (z * BetaWeights[j-1]); // predicted z score
             end;
             Y := Y * StdDevs[NEntered-1] + Means[NEntered-1]; // predicte raw
             k := ColEntered[NEntered-1];
             Y := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[k,i])) - Y; // residual
             BPG := BPG + (Y * Y); // sum of squared residuals
             // save squared value for each case
             OS3MainFrm.DataGrid.Cells[NoVariables,i] := FloatToStr(Y * Y);
//             OS3MainFrm.DataGrid.Cells[NoVariables,i] := Format('%8.3f',[Y * Y]);
        end;
        BPG := BPG / NCases;
        for i := 1 to NCases do
        begin
             Y := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[NoVariables,i])) / BPG;
             OS3MainFrm.DataGrid.Cells[NoVariables,i] := Format('%8.3f',[Y]);
        end;
        // Now, regress Hetero values on the independent variables
        DepVarCol := NoVariables;
        ColEntered[NEntered-1] := NoVariables;
        IndRowLabels[NEntered-1] := OS3MainFrm.DataGrid.Cells[DepVarCol,0];
        IndColLabels[NEntered-1] := OS3MainFrm.DataGrid.Cells[DepVarCol,0];
        Correlations(NEntered,ColEntered,Corrs,Means,Variances,
                    StdDevs,errcode,NCases);
          if CorrsChkBox.Checked = true then
          begin
               title := 'Product-Moment Correlations Matrix';
               MAT_PRINT(Corrs,NEntered,NEntered,title,IndRowLabels,IndColLabels,NCases);
          end;
          title := 'Means';
          if MeansChkBox.Checked = true then
             DynVectorPrint(Means,NEntered,title,IndColLabels,NCases);
          title := 'Variances';
          if VarChkBox.Checked = true then
             DynVectorPrint(Variances,NEntered,title,IndColLabels,NCases);
          title := 'Standard Deviations';
          if SDChkBox.Checked = true then
             DynVectorPrint(StdDevs,NEntered,title,IndColLabels,NCases);
        MReg2(NCases,NEntered,NoIndepVars,IndepIndex,corrs,IndepInverse,
                    IndRowLabels,R2,BetaWeights,
                    Means,Variances,errorcode,StdErrEst,constant,prout,true, false,false);
        BPG := ( R2 * Variances[NEntered-1] * (Ncases-1) ) / 2;
        chiprob := 1.0 - chisquaredprob(BPG,NEntered-1);
        OutPutFrm.RichEdit.Lines.Add('');
        OutPutFrm.RichEdit.Lines.Add('Breusch-Pagan-Godfrey Test of Heteroscedasticity');
        outline := format('Chi-Square = %8.3f with probability greater value = %8.3f',[BPG,chiprob]);
        OutPutFrm.RichEdit.Lines.Add(outline);
        OutPutFrm.RichEdit.Lines.Add('');
   end;
}
     if MatSaveChkBox.Checked = true then
     begin
          SaveDialog1.Filter := 'FreeStat matrix files (*.MAT)|*.MAT|All files (*.*)|*.*';
          SaveDialog1.FilterIndex := 1;
          if SaveDialog1.Execute then
          begin
               filename := SaveDialog1.FileName;
               MATSAVE(Corrs,NoVars,NoVars,Means,StdDevs,NCases,IndRowLabels,IndColLabels,filename);
          end;
     end;
     OutPutFrm.ShowModal;
CleanUp:
     ColEntered := nil;
     Candidate := nil;
     BetaWeights := nil;
     IndColLabels := nil;
     IndRowLabels := nil;
     IndepIndex := nil;
     StdDevs := nil;
     Variances := nil;
     Means := nil;
     IndepInverse := nil;
     corrs := nil;
     VarsInBlk := nil;
     BlkVarCols := nil;
end;

procedure TBlkMregFrm.DepInBtnClick(Sender: TObject);
VAR index : integer;
begin
     index := VarList.ItemIndex;
     DepVar.Text := VarList.Items.Strings[index];
     VarList.Items.Delete(index);
     DepOutBtn.Enabled := true;
     DepInBtn.Enabled := false;
end;

procedure TBlkMregFrm.DepOutBtnClick(Sender: TObject);
begin
     VarList.Items.Add(DepVar.Text);
     DepVar.Text := '';
     DepInBtn.Enabled := true;
end;

procedure TBlkMregFrm.InBtnClick(Sender: TObject);
VAR i, index : integer;
begin
     index := VarList.Items.Count;
     i := 0;
     while i < index do
     begin
         if (VarList.Selected[i]) then
         begin
            BlockList.Items.Add(VarList.Items.Strings[i]);
            VarList.Items.Delete(i);
            index := index - 1;
            i := 0;
         end
         else i := i + 1;
     end;
     OutBtn.Enabled := true;
end;

procedure TBlkMregFrm.NextBlkBtnClick(Sender: TObject);
var
   blkno, i, j, count : integer;
   cellstring : string;
begin
     {save columns of variables in the current block }
     count := BlockList.Items.Count;
     if count = 0 then
     begin
          VarsInBlk[NoBlocks-1] := 0;
          exit;
     end;
     VarsInBlk[NoBlocks-1] := count;
     for i := 0 to count-1 do
     begin
          for j := 1 to NoVariables do
          begin
               cellstring := OS3MainFrm.DataGrid.Cells[j,0];
               if cellstring = BlockList.Items.Strings[i] then
               begin
                    BlkVarCols[NoBlocks-1,i] := j;
                    NoVars := NoVars + 1;
               end;
          end;
     end;
     blkno := StrToInt(BlockNoEdit.Text);
     blkno := blkno + 1;
     BlockNoEdit.Text := IntToStr(blkno);
     NoBlocks := blkno;
     BlockList.Clear;
end;

procedure TBlkMregFrm.OutBtnClick(Sender: TObject);
VAR index : integer;
begin
   index := BlockList.ItemIndex;
   VarList.Items.Add(BlockList.Items.Strings[index]);
   BlockList.Items.Delete(index);
   InBtn.Enabled := true;
   if BlockList.Items.Count = 0 then OutBtn.Enabled := false;
end;

initialization
  {$I blkmregunit.lrs}

end.