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

unit LSMRUnit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
  StdCtrls, Buttons, ExtCtrls, ComCtrls, Globals, MainUnit, MatrixLib, 
  DataProcs, DictionaryUnit, BasicStatsParamsFormUnit, ReportFrameUnit;

type

  { TLSMregForm }

  TLSMregForm = class(TBasicStatsParamsForm)
    AllBtn: TBitBtn;
    IndepVars: TListBox;
    CorrsChkBox: TCheckBox;
    CovChkBox: TCheckBox;
    CPChkBox: TCheckBox;
    DepInBtn: TBitBtn;
    DepOutBtn: TBitBtn;
    DepVar: TEdit;
    OptionsGroup: TGroupBox;
    InBtn: TBitBtn;
    InProb: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label5: TLabel;
    MatSaveChkBox: TCheckBox;
    MeansChkBox: TCheckBox;
    PageControl: TPageControl;
    SaveDialog: TSaveDialog;
    OutBtn: TBitBtn;
    PredictChkBox: TCheckBox;
    StdDevChkBox: TCheckBox;
    RegressionPage: TTabSheet;
    CrossProductsPage: TTabSheet;
    CorrelationsPage: TTabSheet;
    MeanVarStddevPage: TTabSheet;
    VarCovarPage: TTabSheet;
    VarChkBox: TCheckBox;
    VarList: TListBox;
    procedure AllBtnClick(Sender: TObject);
    procedure DepInBtnClick(Sender: TObject);
    procedure DepOutBtnClick(Sender: TObject);
    procedure InBtnClick(Sender: TObject);
    procedure IndepVarsDblClick(Sender: TObject);
    procedure OutBtnClick(Sender: TObject);
    procedure VarListDblClick(Sender: TObject);
    procedure VarListSelectionChange(Sender: TObject; {%H-}User: boolean);
  private
    { private declarations }
    FRegressionFrame: TReportFrame;
    FCrossProductsFrame: TReportFrame;
    FCorrelationsFrame: TReportFrame;
    FVarCovarFrame: TReportFrame;
    FMeanVarStddevFrame: TReportFrame;
    IndepVarsCols: IntDyneVec;
    NoVars: integer;
    NoBlocks: integer;
    procedure HideTabs;
  protected
    procedure AdjustConstraints; override;
    procedure Compute; override;
    procedure UpdateBtnStates; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Reset; override;
  end;

var
  LSMregForm: TLSMregForm;


implementation

{$R *.lfm}

uses
  Math,
  Utils, MathUnit;


{ TLSMregForm }

constructor TLSMregForm.Create(AOwner: TComponent);
begin
  inherited;

  FRegressionFrame := TReportFrame.Create(self);
  FRegressionFrame.Name := '';
  FRegressionFrame.Parent := RegressionPage;
  FRegressionFrame.Align := alClient;
  FRegressionFrame.BorderSpacing.Left := 0;
  FRegressionFrame.BorderSpacing.Top := 0;
  FRegressionFrame.BorderSpacing.Bottom := 0;
  FRegressionFrame.BorderSpacing.Right := 0;
  InitToolbar(FRegressionFrame.ReportToolbar, tpRight);

  FCrossProductsFrame := TReportFrame.Create(self);
  FCrossProductsFrame.Name := '';
  FCrossProductsFrame.Parent := CrossProductsPage;
  FCrossProductsFrame.Align := alClient;
  FCrossProductsFrame.BorderSpacing.Left := 0;
  FCrossProductsFrame.BorderSpacing.Top := 0;
  FCrossProductsFrame.BorderSpacing.Bottom := 0;
  FCrossProductsFrame.BorderSpacing.Right := 0;
  InitToolbar(FCrossProductsFrame.ReportToolbar, tpRight);

  FCorrelationsFrame := TReportFrame.Create(self);
  FCorrelationsFrame.Name := '';
  FCorrelationsFrame.Parent := CorrelationsPage;
  FCorrelationsFrame.Align := alClient;
  FCorrelationsFrame.BorderSpacing.Left := 0;
  FCorrelationsFrame.BorderSpacing.Top := 0;
  FCorrelationsFrame.BorderSpacing.Bottom := 0;
  FCorrelationsFrame.BorderSpacing.Right := 0;
  InitToolbar(FCorrelationsFrame.ReportToolbar, tpRight);

  FVarCovarFrame := TReportFrame.Create(self);
  FVarCovarFrame.Name := '';
  FVarCovarFrame.Parent := VarCovarPage;
  FVarCovarFrame.Align := alClient;
  FVarCovarFrame.BorderSpacing.Left := 0;
  FVarCovarFrame.BorderSpacing.Top := 0;
  FVarCovarFrame.BorderSpacing.Bottom := 0;
  FVarCovarFrame.BorderSpacing.Right := 0;
  InitToolbar(FVarCovarFrame.ReportToolbar, tpRight);

  FMeanVarStddevFrame := TReportFrame.Create(self);
  FMeanVarStddevFrame.Name := '';
  FMeanVarStddevFrame.Parent := MeanVarStdDevPage;
  FMeanVarStddevFrame.Align := alClient;
  FMeanVarStddevFrame.BorderSpacing.Left := 0;
  FMeanVarStddevFrame.BorderSpacing.Top := 0;
  FMeanVarStddevFrame.BorderSpacing.Bottom := 0;
  FMeanVarStddevFrame.BorderSpacing.Right := 0;
  InitToolbar(FMeanVarStddevFrame.ReportToolbar, tpRight);

  PageControl.ActivePage := RegressionPage;
end;


procedure TLSMregForm.AdjustConstraints;
begin
  ParamsPanel.Constraints.MinWidth := Max(
    OptionsGroup.Width,
    4*CloseBtn.Width + 3*CloseBtn.BorderSpacing.Left
  );
  ParamsPanel.Constraints.MinHeight :=  AllBtn.Top + AllBtn.Height +
    VarList.BorderSpacing.Bottom +  InProb.Height +
    OptionsGroup.BorderSpacing.Top + OptionsGroup.Height +
    ButtonBevel.Height + CloseBtn.BorderSpacing.Top + CloseBtn.Height;
end;


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


procedure TLSMregForm.Compute;
var
  i, j, NCases: integer;
  NoIndepVars, DepVarCol, NEntered: integer;
  R2, df1, df2: double;
  StdErrEst, F, FProbF, OldR2: double;
  pdf1, probin, prout: double;
  errorcode: boolean;
  BetaWeights: DblDyneVec = nil;
  BWeights: DblDyneVec = nil;
  BStdErrs: DblDyneVec = nil;
  Bttests: DblDyneVec = nil;
  tProbs: DblDyneVec = nil;
  cellstring: string;
  corrs: DblDyneMat = nil;
  Means: DblDyneVec = nil;
  Variances: DblDyneVec = nil;
  StdDevs: DblDyneVec = nil;
  title: string;
  IndRowLabels: StrDyneVec = nil;
  IndColLabels: StrDyneVec = nil;
  IndepInverse: DblDyneMat = nil;
  ColEntered: IntDyneVec = nil;
  filename: string;
  constant: double;
  errcode: boolean = false;
  anerror: Integer = 0;
  lReport: TStrings;

  procedure AddHeaderToReport;
  begin
    lReport.Clear;
    lReport.Add('LEAST SQUARES MULTIPLE REGRESSION by Bill Miller');
    lReport.Add('');
  end;

begin
  NCases := NoCases;
  SetLength(corrs,NoVariables+1,NoVariables+1);
  SetLength(IndepInverse,NoVariables,NoVariables+1);
  SetLength(IndepVarsCols,NoVariables+1);
  SetLength(BWeights,NoVariables+1);
  SetLength(BStdErrs,NoVariables+1);
  SetLength(Bttests,NoVariables+1);
  SetLength(tProbs,NoVariables+1);
  SetLength(Means,NoVariables+1);
  SetLength(Variances,NoVariables+1);
  SetLength(StdDevs,NoVariables+1);
  SetLength(IndepVarsCols,NoVariables+1);
  SetLength(IndColLabels,NoVariables+1);
  SetLength(IndRowLabels,NoVariables+1);
  SetLength(BetaWeights,NoVariables+1);
  SetLength(ColEntered,NoVariables+2);

  probin := StrToFloat(InProb.Text); // probability to include a block
  prout := 1.0;

  if DepVar.Text = '' then
  begin
    ErrorMsg('No dependent variable selected.');
    exit;
  end;
  if IndepVars.Items.Count = 0 then
  begin
    ErrorMsg('No independent variable selected.');
    exit;
  end;

  lReport := TStringList.Create;
  try
    errorcode := false;

    { get dependendent variable column }
    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;
    NEntered := 0;

    { get independendent variable column }
    for i := 0 to IndepVars.Count-1 do
    begin
      //cellstring := OS3Mainfrm.DataGrid.Cells[i+1,0];   // bug
      cellstring := IndepVars.Items[i];     //Bugfix by tatamata
      for j := 1 to NoVariables do
      begin
        if cellstring = OS3MainFrm.DataGrid.Cells[j,0] then
        begin
          IndepVarsCols[i] := j;
          ColEntered[i] := j;
          NEntered := NEntered + 1;
          IndRowLabels[NEntered-1] := cellstring;
          IndColLabels[NEntered-1] := cellstring;
        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];

    if CPChkBox.Checked  then
    begin
      title := 'Cross-Products Matrix';
      AddHeaderToReport;
      GridXProd(NEntered, ColEntered, Corrs, errcode, NCases);
      MatPrint(Corrs, NEntered, NEntered, title, IndRowLabels, IndColLabels, NCases, lReport);
      FCrossProductsFrame.DisplayReport(lReport);
      CrossProductsPage.TabVisible := true;
    end else
      CrossProductsPage.TabVisible := false;

    if CovChkBox.Checked then
    begin
      title := 'Variance-Covariance Matrix';
      AddHeaderToReport;
      GridCovar(NEntered,ColEntered, Corrs, Means, Variances, StdDevs, errcode, NCases);
      MatPrint(Corrs, NEntered, NEntered, title, IndRowLabels, IndColLabels, NCases, lReport);
      FVarCovarFrame.DisplayReport(lReport);
      VarCovarPage.TabVisible := true;
//      lReport.Add(DIVIDER_SMALL);
    end;

    Correlations(NEntered,ColEntered,Corrs,Means,Variances, StdDevs,errcode,NCases);
    if CorrsChkBox.Checked then
    begin
      title := 'Product-Moment Correlations Matrix';
      AddHeaderToReport;
      MatPrint(Corrs, NEntered, NEntered, title, IndRowLabels, IndColLabels, NCases, lReport);
      FCorrelationsFrame.DisplayReport(lReport);
      CorrelationsPage.TabVisible := true;
    end else
      CorrelationsPage.TabVisible := false;

    if MeansChkBox.Checked or VarChkBox.Checked or StdDevChkBox.Checked then
    begin
      AddHeaderToReport;

      if MeansChkBox.Checked then
      begin
        title := 'MEANS';
        DynVectorPrint(Means, NEntered, title, IndColLabels, NCases, lReport);
        lReport.Add(DIVIDER_SMALL);
        lReport.Add('');
      end;

      if VarChkBox.Checked then
      begin
        title := 'VARIANCES';
        DynVectorPrint(Variances, NEntered, title, IndColLabels, NCases, lReport);
        lReport.Add(DIVIDER_SMALL);
        lReport.Add('');
      end;

      if StdDevChkBox.Checked then
      begin
        title := 'STANDARD DEVIATIONS';
        DynVectorPrint(StdDevs, NEntered, title, IndColLabels, NCases, lReport);
        lReport.Add(DIVIDER_SMALL);
        lReport.Add('');
      end;

      FMeanVarStddevFrame.DisplayReport(lReport);
      MeanVarStddevPage.TabVisible := true;
    end else
      MeanVarStddevPage.TabVisible := false;

    if errorcode then
    begin
      ErrorMsg('A selected variable has no variability. Run aborted.');
      exit;
    end;
    NoIndepVars := NEntered - 1;

    AddHeaderToReport;

    MReg(NoIndepVars, ColEntered, DepVarCol, IndRowLabels, Means, Variances,
         StdDevs, BWeights, BetaWeights, BStdErrs, Bttests, tProbs, R2,
         StdErrEst, NCases, errorcode, true, lReport);

    df1 := NoIndepVars - pdf1;
    df2 := NCases - NoIndepVars - 1;
    F := ((R2 - OldR2) / (1.0 - R2)) * df2 / df1;
    FProbF := ProbF(F,df1,df2);
    lReport.Add('');
    if FProbF < probIn then
      lReport.Add('Entry requirements met')
    else
      lReport.Add('Entry requirements not met');

    lReport.Add('');
    lReport.Add(DIVIDER);
    lReport.Add('');

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

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

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

    if MatSaveChkBox.Checked then
    begin
      SaveDialog.Filter := 'LazStats matrix files (*.mat)|*.mat;*.MAT|All files (*.*)|*.*';
      SaveDialog.FilterIndex := 1;
      if SaveDialog.Execute then
      begin
        filename := SaveDialog.FileName;
        MatSave(Corrs, NoVars, NoVars, Means, StdDevs, NCases, IndRowLabels, IndColLabels, filename);
      end;
    end;

    FRegressionFrame.DisplayReport(lReport);

  finally
    lReport.Free;
  end;
end;


procedure TLSMregForm.DepInBtnClick(Sender: TObject);
var
  index: integer;
begin
  index := VarList.ItemIndex;
  if (index > -1) and (DepVar.Text = '') then
  begin
    DepVar.Text := VarList.Items[index];
    VarList.Items.Delete(index);
  end;
  UpdateBtnStates;
end;


procedure TLSMregForm.DepOutBtnClick(Sender: TObject);
begin
  if DepVar.Text <> '' then
  begin
    VarList.Items.Add(DepVar.Text);
    DepVar.Text := '';
  end;
  UpdateBtnStates;
end;


procedure TLSMregForm.InBtnClick(Sender: TObject);
var
  i: integer;
begin
  i := 0;
  while i < VarList.Items.Count do
  begin
    if VarList.Selected[i] then
    begin
      IndepVars.Items.Add(VarList.Items[i]);
      VarList.Items.Delete(i);
      i := 0;
    end else
      inc(i);
  end;
  UpdateBtnStates;
end;


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


procedure TLSMregForm.HideTabs;
var
  i: Integer;
begin
  for i := 1 to PageControl.PageCount-1 do      // i=1 --> keep 1st page visible
    PageControl.Pages[i].TabVisible := false;
end;


procedure TLSMregForm.OutBtnClick(Sender: TObject);
var
  i: integer;
begin
  i := 0;
  while i < IndepVars.Items.Count do
  begin
    if IndepVars.Selected[i] then
    begin
      VarList.Items.Add(IndepVars.Items[i]);
      IndepVars.Items.Delete(i);
      i := 0;
    end else
      inc(i);
  end;
  UpdateBtnStates;
end;

procedure TLSMregForm.Reset;
var
  i: integer;
begin
  inherited;
	
  IndepVars.Items.Clear;
  NoBlocks := 1;

  VarList.Items.Clear;
  for i := 1 to NoVariables do
    VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);

  CPChkBox.Checked := false;
  CovChkBox.Checked := false;
  CorrsChkBox.Checked := true;
  MeansChkBox.Checked := true;
  VarChkBox.Checked := false;
  StdDevChkBox.Checked := true;
  MatSaveChkBox.Checked := false;
  PredictChkBox.Checked := false;

  NoVars := 0;
  DepVar.Text := '';
  InProb.Text := FormatFloat('0.00', DEFAULT_ALPHA_LEVEL);
  SetLength(IndepVarsCols, NoVariables+1);

  HideTabs;
  UpdateBtnStates;
end;


procedure TLSMregForm.UpdateBtnStates;
var
  lSelected: Boolean;
begin
  inherited;

  if Assigned(FRegressionFrame) then
    FRegressionFrame.UpdateBtnStates;
  if Assigned(FCrossProductsFrame) then
    FCrossProductsFrame.UpdateBtnStates;
  if Assigned(FCorrelationsFrame) then
    FCorrelationsFrame.UpdateBtnStates;
  if Assigned(FVarCovarFrame) then
    FVarCovarFrame.UpdateBtnStates;
  if Assigned(FMeanVarStddevFrame) then
    FMeanVarStddevFrame.UpdateBtnStates;

  lSelected := AnySelected(VarList);
  DepInBtn.Enabled := lSelected;
  InBtn.Enabled := lSelected;
  OutBtn.Enabled := AnySelected(IndepVars);
  DepOutBtn.Enabled := DepVar.Text <> '';
  AllBtn.Enabled := VarList.Items.Count > 0;
end;


procedure TLSMregForm.VarListDblClick(Sender: TObject);
var
  index: Integer;
begin
  index := VarList.ItemIndex;
  if index > -1 then
  begin
    if DepVar.Text = '' then
      DepVar.Text := VarList.Items[index]
    else
      IndepVars.Items.Add(VarList.Items[index]);
    VarList.Items.Delete(index);
    UpdateBtnStates;
  end;
end;


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


end.