lazarus-ccr/applications/lazstats/source/forms/analysis/multiple_regression/simultregunit.pas

// Use file "cansas.laz" for testing, all variables.

unit SimultRegUnit;

{$mode objfpc}{$H+}

interface

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

type

  { TSimultForm }

  TSimultForm = class(TBasicStatsReportForm)
    OpenDialog1: TOpenDialog;
    MatInChkBox: TCheckBox;
    MatSaveChkBox: TCheckBox;
    CPChkBox: TCheckBox;
    CovChkBox: TCheckBox;
    CorrsChkBox: TCheckBox;
    MeansChkBox: TCheckBox;
    SaveDialog1: TSaveDialog;
    VarChkBox: TCheckBox;
    SDChkBox: TCheckBox;
    InvMatChkBox: TCheckBox;
    OptionsGroup: TGroupBox;
    InBtn: TBitBtn;
    OutBtn: TBitBtn;
    AllBtn: TBitBtn;
    Label1: TLabel;
    Label2: TLabel;
    SelList: TListBox;
    VarList: TListBox;
    procedure AllBtnClick(Sender: TObject);
    procedure InBtnClick(Sender: TObject);
    procedure OutBtnClick(Sender: TObject);
    procedure SelListDblClick(Sender: TObject);
    procedure VarListDblClick(Sender: TObject);
    procedure VarListSelectionChange(Sender: TObject; {%H-}User: boolean);
  private
	
  protected
    procedure AdjustConstraints; override;
    procedure Compute; override;
    procedure UpdateBtnStates; override;
		
  public
    procedure Reset; override;
  end; 

var
  SimultForm: TSimultForm;


implementation

{$R *.lfm}

uses
  Math,
  Utils, MathUnit;


{ TSimultForm }

procedure TSimultForm.AdjustConstraints;
begin
  inherited;

  ParamsPanel.Constraints.MinWidth := Max(
    4*CloseBtn.Width + 3*CloseBtn.BorderSpacing.Left,
    OptionsGroup.Width);

  ParamsPanel.Constraints.MinHeight := AllBtn.Top + AllBtn.Height +
    VarList.BorderSpacing.Bottom + OptionsGroup.Height + ButtonBevel.Height +
    CloseBtn.BorderSpacing.Top + CloseBtn.Height;
end;


procedure TSimultForm.AllBtnClick(Sender: TObject);
var
  index: integer;
begin
  for index := 0 to VarList.Items.Count-1 do
    SelList.Items.Add(VarList.Items[index]);
  VarList.Clear;
  UpdateBtnStates;
end;

procedure TSimultForm.Compute;
var
   NoVars, i, j, NCases, errcode: integer;
   StdErr, df1, df2, x, determinant : double;
   errorcode : boolean = false;
   filename : string;
   cellstring, valstring : string;
   Corrs : DblDyneMat = nil;
   Means : DblDyneVec = nil;
   Variances : DblDyneVec = nil;
   StdDevs : DblDyneVec = nil;
   ColNoSelected : IntDyneVec = nil;
   title : string;
   RowLabels : StrDyneVec = nil;
   ColLabels : StrDyneVec = nil;
   InverseMat : DblDyneMat = nil;
   R2s : DblDyneVec = nil;
   W : DblDyneVec = nil;
   ProdMat : DblDyneMat = nil;
   FProbs : DblDyneVec = nil;
   CorrMat : DblDyneMat = nil;
   lReport: TStrings;

begin
     SetLength(Corrs,NoVariables+1,NoVariables+1);
     SetLength(Means,NoVariables);
     SetLength(Variances,NoVariables);
     SetLength(StdDevs,NoVariables);
     SetLength(RowLabels,NoVariables);
     SetLength(ColLabels,NoVariables);
     SetLength(InverseMat,NoVariables,NoVariables);
     SetLength(R2s,NoVariables);
     SetLength(W,NoVariables);
     SetLength(ProdMat,NoVariables+1,NoVariables+1);
     SetLength(Fprobs,NoVariables);
     SetLength(CorrMat,NoVariables+1,NoVariables+1);
     SetLength(ColNoSelected,NoVariables);

     lReport := TStringList.Create;
     try
       lReport.Add('SIMULTANEOUS MULTIPLE REGRESSION by Bill Miller');
       lReport.Add('------------------------------------------------------------------');
       lReport.Add('');
       errcode := 0;
       if MatInChkBox.Checked  then
       begin
          OpenDialog1.Filter := 'FreeStat 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);
               for i := 1 to NoVars do Variances[i-1] := sqr(StdDevs[i-1]);
               MessageDlg('Last variable in matrix is the dependent variable', mtInformation, [mbOK], 0);
          end;
       end else
       begin
          { get variable columns }
          NoVars := SelList.Items.Count;
          if NoVars < 1 then
          begin
               MessageDlg('No variables selected.',mtError, [mbOK], 0);
               exit;
          end;
          for i := 1 to NoVars do
          begin
               cellstring := SelList.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;
       end;

       if CPChkBox.Checked then
       begin
          title := 'Cross-Products Matrix';
          GridXProd(NoVars,ColNoSelected,Corrs,errorcode,NCases);
          MatPrint(Corrs,NoVars,NoVars,title,RowLabels,ColLabels,NCases, lReport);
          lReport.Add('------------------------------------------------------------------');
          lReport.Add('');
       end;

       if CovChkBox.Checked then
       begin
          title := 'Variance-Covariance Matrix';
          GridCovar(NoVars,ColNoSelected,Corrs,Means,Variances,
                      StdDevs,errorcode,NCases);
          MatPrint(Corrs,NoVars,NoVars,title,RowLabels,ColLabels,NCases, lReport);
          lReport.Add('------------------------------------------------------------------');
          lReport.Add('');
       end;

       Correlations(NoVars,ColNoSelected,Corrs,Means,Variances, StdDevs,errorcode,NCases);

       if CorrsChkBox.Checked = true then
       begin
         for i := 1 to NoVars do
           for j := 1 to NoVars do InverseMat[i-1,j-1] := Corrs[i-1,j-1];
         title := 'Product-Moment Correlations Matrix';
         MatPrint(Corrs,NoVars,NoVars,title,RowLabels,ColLabels,NCases, lReport);
         lReport.Add('------------------------------------------------------------------');
         lReport.Add('');
       end;

       if MatSaveChkBox.Checked then
       begin
          SaveDialog1.Filter := 'OpenStat 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);
          end;
       end;

       title := 'Means';
       if MeansChkBox.Checked = true then
       begin
         title := 'Means';
         DynVectorPrint(Means,NoVars,title,ColLabels,NCases, lReport);
         lReport.Add('------------------------------------------------------------------');
         lReport.Add('');
       end;

       if VarChkBox.Checked  then
       begin
          title := 'Variances';
          DynVectorPrint(Variances,NoVars,title,ColLabels,NCases, lReport);
          lReport.Add('------------------------------------------------------------------');
          lReport.Add('');
       end;

       if SDChkBox.Checked then
       begin
          title := 'Standard Deviations';
          DynVectorPrint(StdDevs,NoVars,title,ColLabels,NCases, lReport);
          lReport.Add('------------------------------------------------------------------');
          lReport.Add('');
       end;

       if errcode > 0 then
       begin
         lReport.Add('One or more correlations could not be computed due to zero variance of a variable.');
         MessageDlg('A selected variable has no variability-run aborted.', mtError, [mbOK], 0);
         exit;
       end;

       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,errorcode);
       if (determinant < 0.000001) then
       begin
         MessageDlg('Matrix is singular.', mtError, [mbOK], 0);
         exit;
       end;
       lReport.Add('Determinant of correlation matrix = %8.4f', [Determinant]);
       lReport.Add('');

       SVDinverse(InverseMat, NoVars);
       if InvMatChkBox.Checked then
       begin
         title := 'Inverse of correlation matrix';
         MatPrint(InverseMat,NoVars,NoVars,title,RowLabels,ColLabels,NCases, lReport);
         lReport.Add('------------------------------------------------------------------');
         lReport.Add('');
       end;

       lReport.Add('Multiple Correlation Coefficients for Each Variable');
       lReport.Add('');
       lReport.Add('%10s%8s%10s%10s%12s%5s%5s', ['Variable','R','R2','F','Prob.>F','DF1','DF2']);

       df1 := NoVars - 1.0;
       df2 := NCases - NoVars;

       for i := 1  to NoVars do
       begin   // R squared values
         R2s[i-1] := 1.0 - (1.0 / InverseMat[i-1,i-1]);
         W[i-1] := (R2s[i-1] / df1) / ((1.0-R2s[i-1]) / df2);
         FProbs[i-1] := ProbF(W[i-1],df1,df2);
         valstring := format('%10s',[ColLabels[i-1]]);
         lReport.Add('%10s%10.3f%10.3f%10.3f%10.3f%5.0f%5.0f', [
           valstring,sqrt(R2s[i-1]),R2s[i-1],W[i-1],FProbs[i-1],df1,df2
         ]);
         for j := 1 to NoVars do
         begin  // betas
           ProdMat[i-1,j-1] := -InverseMat[i-1,j-1] / InverseMat[j-1,j-1];
         end;
       end;
       lReport.Add('------------------------------------------------------------------');
       lReport.Add('');

       title := 'Betas in Columns';
       MatPrint(ProdMat,NoVars,NoVars,title,RowLabels,ColLabels,NCases, lReport);
       lReport.Add('Standard Errors of Prediction');
       lReport. Add('Variable     Std.Error');
       for i := 1 to NoVars do
       begin
         StdErr := (NCases-1) * Variances[i-1] * (1.0 / InverseMat[i-1,i-1]);
          StdErr := sqrt(StdErr / (NCases - NoVars));
          valstring := format('%10s', [ColLabels[i-1]]);
          lReport.Add('%10s%10.3f', [valstring,StdErr]);
       end;
       lReport.Add('------------------------------------------------------------------');
       lReport.Add('');

       for i := 1 to NoVars do
         for j := 1 to NoVars do
          if (i <> j) then ProdMat[i-1,j-1] := ProdMat[i-1,j-1] * (StdDevs[j-1]/StdDevs[i-1]);
       title := 'Raw Regression Coefficients';
       MatPrint(ProdMat,NoVars,NoVars,title,RowLabels,ColLabels,NCases, lReport);
       lReport.Add('Variable   Constant');
        for i := 1 to NoVars do
        begin
    	  x := 0.0;
          for j := 1 to NoVars do
          begin
        	if (i <> j) then x := x + (ProdMat[j-1,i-1] * Means[j-1]);
          end;
          x := Means[i-1] - x;
          valstring := format('%10s',[ColLabels[i-1]]);
          lReport.Add('%10s%10.3f', [valstring, x]);
        end;
        lReport.Add('------------------------------------------------------------------');
        lReport.Add('');

        // Get partial correlation matrix
        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;
        title := 'Partial Correlations';
        MatPrint(ProdMat,NoVars,NoVars,title,RowLabels,ColLabels,NCases, lReport);

     finally
       if lReport.Count > 0 then
         FReportFrame.DisplayReport(lReport);

       ColNoSelected := nil;
       CorrMat := nil;
       Fprobs := nil;
       ProdMat := nil;
       W := nil;
       R2s := nil;
       InverseMat := nil;
       ColLabels := nil;
       RowLabels := nil;
       StdDevs := nil;
       Variances := nil;
       Means := nil;
       corrs := nil;
     end;
end;


procedure TSimultForm.InBtnClick(Sender: TObject);
var
  i: integer;
begin
  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
       inc(i);
  end;
  UpdateBtnStates;
end;


procedure TSimultForm.OutBtnClick(Sender: TObject);
var
  i: integer;
begin
  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
       inc(i);
  end;
  UpdateBtnStates;
end;


procedure TSimultForm.Reset;
var
  i: integer;
begin
  inherited;

  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 := false;
  MeansChkBox.Checked := false;
  VarChkBox.Checked := false;
  SDChkBox.Checked := false;
  MatInChkBox.Checked := false;
  MatSaveChkBox.Checked := false;

  UpdateBtnStates;
end;


procedure TSimultForm.SelListDblClick(Sender: TObject);
var
  index: Integer;
begin
  index := SelList.ItemIndex;
  if index > -1 then
  begin
    VarList.Items.Add(SelList.Items[index]);
    SelList.Items.Delete(index);
    UpdateBtnStates;
  end;
end;

procedure TSimultForm.VarListDblClick(Sender: TObject);
var
  index: Integer;
begin
  index := VarList.ItemIndex;
  if index > -1 then
  begin
    SelList.Items.Add(VarList.Items[index]);
    VarList.Items.Delete(index);
    UpdateBtnStates;
  end;
end;


procedure TSimultForm.VarListSelectionChange(Sender: TObject; User: boolean);
begin
  UpdateBtnStates;
end;


procedure TSimultForm.UpdateBtnStates;
begin
  inherited;
	
  InBtn.Enabled := AnySelected(VarList);
  OutBtn.Enabled := AnySelected(SelList);
  AllBtn.Enabled := VarList.Items.Count > 0;
end;

end.