unit BackRegUnit;

{$mode objfpc}{$H+}

interface

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

type

  { TBackRegFrm }

  TBackRegFrm = class(TForm)
    OpenDialog1: TOpenDialog;
    ResetBtn: TButton;
    CancelBtn: TButton;
    ComputeBtn: TButton;
    ReturnBtn: TButton;
    InBtn: TBitBtn;
    OutBtn: TBitBtn;
    AllBtn: TBitBtn;
    DepInBtn: TBitBtn;
    DepOutBtn: TBitBtn;
    MatInChkBox: TCheckBox;
    MatSaveChkBox: TCheckBox;
    CPChkBox: TCheckBox;
    CovChkBox: TCheckBox;
    CorrsChkBox: TCheckBox;
    MeansChkBox: TCheckBox;
    SaveDialog1: TSaveDialog;
    VarChkBox: TCheckBox;
    SDChkBox: TCheckBox;
    PartialsChkBox: TCheckBox;
    DepVar: TEdit;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    ListBox1: 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 OutBtnClick(Sender: TObject);
    procedure ResetBtnClick(Sender: TObject);
    procedure ReturnBtnClick(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end; 

var
  BackRegFrm: TBackRegFrm;

implementation

{ TBackRegFrm }

procedure TBackRegFrm.ResetBtnClick(Sender: TObject);
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;
end;

procedure TBackRegFrm.ReturnBtnClick(Sender: TObject);
begin
     BackRegFrm.Hide;
end;

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

procedure TBackRegFrm.AllBtnClick(Sender: TObject);
VAR count, 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;
end;

procedure TBackRegFrm.CancelBtnClick(Sender: TObject);
begin
     BackRegFrm.Hide;
end;

procedure TBackRegFrm.ComputeBtnClick(Sender: TObject);
Label CleanUp;
VAR
   NoVars, NoIndepVars, i, j, NCases, mattype, StepNo : integer;
   Index, IndexX, IndexY : integer;
   R2, StdErr, df1, df2, x, determinant, stderrest, POut, LowestPartial : double;
   errorcode : integer;
   errcode : boolean;
   filename : string;
   cellstring, outline, valstring : string;
   Corrs : DblDyneMat;
   Means : DblDyneVec;
   Variances : DblDyneVec;
   StdDevs : DblDyneVec;
   ColNoSelected : IntDyneVec;
   title : string;
   RowLabels : StrDyneVec;
   ColLabels : StrDyneVec;
   InverseMat : DblDyneMat;
   ProdMat : DblDyneMat;
   CorrMat : DblDyneMat;
   BetaWeights : DblDyneVec;
   IndepIndex : IntDyneVec;
   constant : double;
begin
     if NoVariables = 0 then NoVariables := 200;
     SetLength(Corrs,NoVariables+1,NoVariables+1);
     SetLength(Means,NoVariables);
     SetLength(Variances,NoVariables);
     SetLength(StdDevs,NoVariables);
     SetLength(RowLabels,NoVariables);
     SetLength(ColLabels,NoVariables);
     SetLength(InverseMat,NoVariables+1,NoVariables+1);
     SetLength(ProdMat,NoVariables+1,NoVariables+1);
     SetLength(CorrMat,NoVariables+1,NoVariables+1);
     SetLength(BetaWeights,NoVariables);
     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 (*.*)|*.*';
          OpenDialog1.FilterIndex := 1;
          if OpenDialog1.Execute then
          begin
               filename := OpenDialog1.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]);
               CPChkBox.Checked := false;
               CovChkBox.Checked := false;
               MatSaveChkBox.Checked := false;
               ShowMessage('NOTICE! Last variable in matrix is the dependent variable');
          end;
     end;
     if MatInChkBox.Checked = false then
     begin
          { get variable columns }
          NoVars := ListBox1.Items.Count;
          if NoVars < 1 then
          begin
               ShowMessage('ERROR! No variables selected.');
               goto CleanUp;
          end;
          for i := 1 to NoVars do
          begin
               cellstring := ListBox1.Items.Strings[i-1];
               for j := 1 to NoVariables do
               begin
                    if cellstring = OS3MainFrm.DataGrid.Cells[j,0] then
                    begin
                         ColNoSelected[i-1] := j;
                         RowLabels[i-1] := cellstring;
                         ColLabels[i-1] := cellstring;
                    end;
               end;
          end;
          { get dependendent variable column }
          if DepVar.Text = '' then
          begin
               ShowMessage('ERROR! No Dependent variable selected.');
               goto CleanUp;
          end;
          NoVars := NoVars + 1;
          for j := 1 to NoVariables do
          begin
               if DepVar.Text = OS3MainFrm.DataGrid.Cells[j,0] then
               begin
                    ColNoSelected[NoVars-1] := j;
                    RowLabels[NoVars-1] := DepVar.Text;
                    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
          begin
               title := 'Cross-Products Matrix';
               GridXProd(NoVars,ColNoSelected,Corrs,errcode,NCases);
               MAT_PRINT(Corrs,NoVars,NoVars,title,RowLabels,ColLabels,NCases);
          end;
          if CovChkBox.Checked = true then
          begin
               title := 'Variance-Covariance Matrix';
               GridCovar(NoVars,ColNoSelected,Corrs,Means,Variances,
                      StdDevs,errcode,NCases);
               MAT_PRINT(Corrs,NoVars,NoVars,title,RowLabels,ColLabels,NCases);
          end;
          if MatInChkBox.Checked = false then
               Correlations(NoVars,ColNoSelected,Corrs,Means,Variances,
                    StdDevs,errcode,NCases);
          if CorrsChkBox.Checked = true then
          begin
               title := 'Product-Moment Correlations Matrix';
               MAT_PRINT(Corrs,NoVars,NoVars,title,RowLabels,ColLabels,NCases);
          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,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 errorcode > 0 then
          begin
               ShowMessage('ERROR! A selected variable has no variability-run aborted.');
               goto CleanUp;
          end;

          { get determinant of the correlation matrix }
          determinant := 0.0;
          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);
          if (determinant < 0.000001) then
          begin
               ShowMessage('ERROR! Matrix is singular!');
//               goto cleanup;
          end;
          outline := format('Determinant of correlation matrix = %8.4f',[determinant]);
          OutPutFrm.RichEdit.Lines.Add(outline);
          OutPutFrm.RichEdit.Lines.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);
        // 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
    	      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
              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
              title := 'Partial Correlations';
              DynVectorPrint(BetaWeights,NoIndepVars,title,ColLabels,NCases);
         end;
         OutPutFrm.ShowModal;

         { 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);
              for i := Index to NoVars-1 do
              begin
                   ColNoSelected[i-1] := ColNoSelected[i];
                   ColLabels[i-1] := ColLabels[i];
                   RowLabels[i-1] := RowLabels[i];
              end;
              NoVars := NoVars - 1;
              StepNo := StepNo + 1;
         end
         else NoVars := 0;
     end;
     OutPutFrm.ShowModal;

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;
     BackRegFrm.Hide;
end;

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

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

procedure TBackRegFrm.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
            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;
end;

procedure TBackRegFrm.OutBtnClick(Sender: TObject);
VAR index : integer;
begin
   index := ListBox1.ItemIndex;
   VarList.Items.Add(ListBox1.Items.Strings[index]);
   ListBox1.Items.Delete(index);
   InBtn.Enabled := true;
end;

initialization
  {$I backregunit.lrs}

end.