lazarus-ccr/applications/lazstats/source_orig/bnestaunit.pas

unit BNestAUnit;

{$mode objfpc}{$H+}

interface

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

type

  { TBNestedAForm }

  TBNestedAForm = class(TForm)
    ACodes: TEdit;
    AInBtn: TBitBtn;
    AOutBtn: TBitBtn;
    BCodes: TEdit;
    BInBtn: TBitBtn;
    BOutBtn: TBitBtn;
    CancelBtn: TButton;
    RandomBChk: TCheckBox;
    DepInBtn: TBitBtn;
    ComputeBtn: TButton;
    DepOutBtn: TBitBtn;
    DepEdit: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Memo1: TMemo;
    OptionsBox: TRadioGroup;
    ResetBtn: TButton;
    ReturnBtn: TButton;
    VarList: TListBox;
    procedure AInBtnClick(Sender: TObject);
    procedure AOutBtnClick(Sender: TObject);
    procedure BInBtnClick(Sender: TObject);
    procedure BOutBtnClick(Sender: TObject);
    procedure ComputeBtnClick(Sender: TObject);
    procedure DepInBtnClick(Sender: TObject);
    procedure DepOutBtnClick(Sender: TObject);
    procedure ResetBtnClick(Sender: TObject);
  private
    { private declarations }
    SS, SumSqr, CellMeans, CellSDs : DblDyneMat;
    CellCount : IntDyneMat;
    ASS, BSS, ASumSqr, BSumSqr, AMeans, BMeans, ASDs : DblDyneVec;
    ACount, BCount : IntDyneVec;
    MinA, MinB, MaxA, MaxB, NoALevels, NoBLevels, ACol, BCol, YCol : integer;
    DepVar, FactorA, FactorB : string;
    SSTot, SumSqrTot, TotMean, MSTot, SSA, MSA, SSB, MSB, SSW, MSW : double;
    TotN, dfA, dfBwA, dfwcell, dftotal : integer;

    procedure GetVars(Sender: TObject);
    procedure GetMemory(Sender: TOBject);
    procedure GetSums(Sender: TObject);
    procedure ShowMeans(Sender: TObject);
    procedure GetResults(Sender: TObject);
    procedure ShowResults(Sender: TObject);
    procedure ReleaseMemory(Sender: TObject);
    procedure TwoWayPlot(Sender: TObject);

  public
    { public declarations }
  end; 

var
  BNestedAForm: TBNestedAForm;

implementation

{ TBNestedAForm }

procedure TBNestedAForm.ResetBtnClick(Sender: TObject);
VAR i : integer;
begin
  VarList.Items.Clear;
  ACodes.Text := '';
  BCodes.Text := '';
  DepEdit.Text := '';
  AInBtn.Visible := true;
  AOutBtn.Visible := false;
  BInBtn.Visible := true;
  BOutBtn.Visible := false;
  DepInBtn.Visible := true;
  DepoutBtn.Visible := false;
  OptionsBox.ItemIndex := 0;
  for i := 1 to NoVariables do
      VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
  OptionsBox.ItemIndex := 3;
end;

procedure TBNestedAForm.AInBtnClick(Sender: TObject);
VAR index : integer;
begin
     index := VarList.ItemIndex;
     ACodes.Text := VarList.Items.Strings[index];
     VarList.Items.Delete(index);
     AinBtn.Visible := false;
     AOutBtn.Visible := true;
end;

procedure TBNestedAForm.AOutBtnClick(Sender: TObject);
begin
     VarList.Items.Add(ACodes.Text);
     ACodes.Text := '';
     AinBtn.Visible := true;
     AOutBtn.Visible := false;
end;

procedure TBNestedAForm.BInBtnClick(Sender: TObject);
VAR index : integer;
begin
     index := VarList.ItemIndex;
     BCodes.Text := VarList.Items.Strings[index];
     VarList.Items.Delete(index);
     BInBtn.Visible := false;
     BOutBtn.Visible := true;
end;

procedure TBNestedAForm.BOutBtnClick(Sender: TObject);
begin
     VarList.Items.Add(BCodes.Text);
     BCodes.Text := '';
     BInBtn.Visible := true;
     BOutBtn.Visible := false;
end;

procedure TBNestedAForm.ComputeBtnClick(Sender: TObject);
begin
  GetVars(self);
  GetMemory(self);
  GetSums(self);
  ShowMeans(self);
  GetResults(self);
  ShowResults(self);
  TwoWayPlot(self);
  ReleaseMemory(self);
end;

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

procedure TBNestedAForm.DepOutBtnClick(Sender: TObject);
begin
     VarList.Items.Add(DepEdit.Text);
     DepEdit.Text := '';
     DepInBtn.Visible := true;
     DepOutBtn.Visible := false;
end;

procedure TBNestedAForm.GetVars(Sender: TObject);
VAR
  result, intvalue, i, group : integer;
  AValue, BValue : integer;
  strvalue, cellstring : string;
begin
  DepVar := DepEdit.Text;
  FactorA := ACodes.Text;
  FactorB := BCodes.Text;
  ACol := 0;
  BCol := 0;
  YCol := 0;
  MinA := 1000;
  MaxA := -1000;
  MinB := 1000;
  MaxB := -1000;
  for i := 1 to NoVariables do
      begin
        strvalue := Trim(OS3MainFrm.DataGrid.Cells[i,0]);
        if FactorA = strvalue then ACol := i;
        if FactorB = strvalue then BCol := i;
        if DepVar = strvalue then YCol := i;
      end;
  if (ACol = 0) or (BCol = 0) or (YCol = 0) then
     begin
          ShowMessage('ERROR! Select a variable for each entry box.');
          exit;
     end;
  // get number of levels for Factors
  for i := 1 to NoCases do
      begin
        cellstring := Trim(OS3MainFrm.DataGrid.Cells[ACol,i]);
        group := round(StrToFloat(cellstring));
        if (group > MaxA) then MaxA := group;
        if (group < MinA) then MinA := group;
        cellstring := Trim(OS3MainFrm.DataGrid.Cells[BCol,i]);
        group := round(StrToFLoat(cellstring));
        if (group > MaxB) then MaxB := group;
        if (group < MinB) then MinB := group;
      end;
  NoALevels := MaxA - MinA + 1;
  NoBLevels := MaxB - MinB + 1;

end;

procedure TBNestedAForm.GetMemory(Sender: TOBject);
begin
  SetLength(SS,NoBLevels,NoALevels);
  SetLength(SumSqr,NoBLevels,NoALevels);
  SetLength(CellCount,NoBLevels,NoALevels);
  SetLength(CellMeans,NoBLevels,NoALevels);
  SetLength(CellSDs,NoBLevels,NoALevels);
  SetLength(ASS,NoALevels);
  SetLength(BSS,NoBLevels);
  SetLength(ASumSqr,NoALevels);
  SetLength(BSumSqr,NoBLevels);
  SetLength(AMeans,NoALevels);
  SetLength(BMeans,NoBLevels);
  SetLength(ACount,NoALevels);
  SetLength(BCount,NoBLevels);
  SetLength(ASDs,NoALevels);
end;

procedure TBNestedAForm.GetSums(Sender: TObject);
VAR
  Aindex, Bindex, result, intvalue, i, j : integer;
  YValue : double;
  strvalue : string;
begin
  // initialize memory
  for i := 0 to NoBLevels-1 do
      begin
           for j := 0 to NoALevels-1 do
               begin
                  SS[i,j] := 0.0;
                  SumSqr[i,j] := 0.0;
                  CellCount[i,j] := 0;
               end;
      end;
  for i := 0 to NoALevels-1 do
      begin
         ACount[i] := 0;
         AMeans[i] := 0.0;
         ASS[i] := 0.0;
         ASumSqr[i] := 0.0;
      end;
  for j := 0 to NoBLevels-1 do
      begin
         BCount[i] := 0;
         BMeans[i] := 0.0;
         BSS[i] := 0.0;
         BSumSqr[i] := 0.0;
      end;
  // Accumulate sums and sums of squared values
  for i := 1 to NoCases do
      begin
         strvalue := Trim(OS3MainFrm.DataGrid.Cells[ACol,i]);
         Aindex := round(StrToFloat(strvalue));
         strvalue := Trim(OS3MainFrm.DataGrid.Cells[BCol,i]);
         Bindex := round(StrToFloat(strvalue));
         strvalue := Trim(OS3MainFrm.DataGrid.Cells[YCol,i]);
         YValue := StrToFloat(strvalue);
         Aindex := Aindex - MinA;
         Bindex := Bindex - MinB;
         SS[Bindex,Aindex] := SS[Bindex,Aindex] + YValue * YValue;
         SumSqr[Bindex,Aindex] := SumSqr[Bindex,Aindex] + YValue;
         CellCount[Bindex,Aindex] := CellCount[Bindex,Aindex] + 1;
         ACount[Aindex] := ACount[Aindex] + 1;
         BCount[Bindex] := BCount[Bindex] + 1;
         ASS[Aindex] := ASS[Aindex] + YValue * YValue;
         BSS[Bindex] := BSS[Bindex] + YValue * YValue;
         ASumSqr[Aindex] := ASumSqr[Aindex] + YValue;
         BSumSqr[Bindex] := BSumSqr[Bindex] + YValue;
         SSTot := SSTot + YValue * YValue;
         SumSqrTot := SumSqrTot + YValue;
         TotN := TotN + 1;
      end;
  //get cell means and marginal means, SDs plus square of sums
  for i := 0 to NoBlevels-1 do
      begin
         for j := 0 to NoALevels-1 do
             begin
                if CellCount[i,j] > 0 then
                   begin
                     CellMeans[i,j] := SumSqr[i,j] / CellCount[i,j];
                     SumSqr[i,j] := SumSqr[i,j] * SumSqr[i,j];
                     CellSDs[i,j] := SS[i,j] - (SumSqr[i,j] / CellCount[i,j]);
                     CellSDs[i,j] := CellSDs[i,j] / (CellCount[i,j] - 1);
                     CellSDs[i,j] := Sqrt(CellSDs[i,j]);
                   end;
             end;
      end;
  for i := 0 to NoBLevels-1 do
      begin
         BMeans[i] := BSumSqr[i] / BCount[i];
         BSumSqr[i] := BSumSqr[i] * BSumSqr[i];
      end;
  for i := 0 to NoALevels-1 do
      begin
         AMeans[i] := ASumSqr[i] / ACount[i];
         ASumSqr[i] := ASumSqr[i] * ASumSqr[i];
         ASDs[i] := ASS[i] - (ASumSqr[i] / ACount[i]);
         ASDs[i] := ASDs[i] / (ACount[i] - 1);
         ASDs[i] := Sqrt(ASDs[i]);
      end;
  TotMean := SumSqrTot / TotN;
  SumSqrTot := SumSqrTot * SumSqrTot;
end;

procedure TBNestedAForm.ShowMeans(Sender: TObject);
VAR
  outvalue : string;
  i, j : integer;
begin
    OutPutFrm.RichEdit.Clear;
    OutPutFrm.RichEdit.Lines.Add('Nested ANOVA by Bill Miller');
    outvalue := format('File Analyzed = %s',[OS3MainFrm.FileNameEdit.Text]);
    OutPutFrm.RichEdit.Lines.Add(outvalue);
    OutPutFrm.RichEdit.Lines.Add('');
    OutPutFrm.RichEdit.Lines.Add('CELL MEANS');
    OutPutFrm.RichEdit.Lines.Add('A LEVEL     BLEVEL         MEAN       STD.DEV.');
    for i := 0 to NoALevels-1 do
        begin
           for j := 0 to NoBLevels-1 do
               begin
                  if CellCount[j,i] > 0 then
                     begin
                          outvalue := format('%5d     %5d        %10.3f     %10.3f',
                             [i+MinA,j+MinB,CellMeans[j,i],CellSDs[j,i]]);
                          OutPutFrm.RichEdit.Lines.Add(outvalue);
                     end;
               end;
        end;
    OutPutFrm.RichEdit.Lines.Add('');
    OutPutFrm.RichEdit.Lines.Add('A MARGIN MEANS');
    OutPutFrm.RichEdit.Lines.Add('A LEVEL       MEAN       STD.DEV.');
    for i := 0 to NoALevels-1 do
        begin
           outvalue := format('%5d     %10.3f       %10.3f',[i+MinA,AMeans[i],ASDs[i]]);
           OutPutFrm.RichEdit.Lines.Add(outvalue);
        end;
    OutPutFrm.RichEdit.Lines.Add('');
    outvalue := format('GRAND MEAN = %10.3f',[TotMean]);
    OutPutFrm.RichEdit.Lines.Add(outvalue);
    OutPutFrm.RichEdit.Lines.Add('');
//    OutPutFrm.ShowModal;
end;

procedure TBNestedAForm.GetResults(Sender: TObject);
VAR
  temp, constant : double;
  NoBLevelsInA, BLevCount, i, j, celln : integer;
  strvalue : string;
begin
  celln := 0;
  for i := 0 to NoALevels-1 do
      begin
         for j := 0 to NoBLevels-1 do
             begin
                if CellCount[j,i] > celln then celln := CellCount[j,i];
             end;
      end;
  // assume all cells have same n size
  // get no. of levels in A
  BLevCount := 0;
  for i := 0 to NoALevels-1 do
      begin
         NoBLevelsInA := 0;
         for j := 0 to NoBLevels-1 do
             begin
                if CellCount[j,i] > 0 then NoBLevelsInA := NoBLevelsInA + 1;
             end;
         if NoBLevelsInA > BLevCount then BLevCount := NoBLevelsInA;
      end;
  dfA := NoALevels - 1;
  dfBwA := NoALevels * (BLevCount - 1);
  dfwcell := NoALevels * BLevCount * (celln - 1);
  dftotal := TotN - 1;
  constant := SumSqrTot / TotN;
  SSTot := SSTot - constant;
  MSTot := SSTot / dftotal;
  SSA := 0.0;
  for i := 0 to NoALevels-1 do SSA := SSA + (ASumSqr[i] / ACount[i]);
  temp := SSA;
  SSA := SSA - constant;
  MSA := SSA / dfA;
  SSB := 0.0;
  for i := 0 to NoALevels - 1 do
      begin
         for j := 0 to NoBLevels-1 do
             begin
                if CellCount[j,i] > 0 then SSB := SSB + (SumSqr[j,i] / CellCount[j,i]);
             end;
      end;
  SSB := SSB - temp;
  MSB := SSB / dfBwA;
  SSW := SSTot - SSA - SSB;
  MSW := SSW / dfwcell;
 (*
  OutPutFrm.RichEdit.Clear;
  strvalue := format('SSA = %10.3f  MSA = %10.3f  SSB = %10.3f  MSB = %10.3f',
     [SSA,MSA,SSB,MSB]);
  OutPutFrm.RichEdit.Lines.Add(strvalue);
  strvalue := format('SSW = %10.3f  MSW = %10.3f',[SSW,MSW]);
  OutPutFrm.RichEdit.Lines.Add(strvalue);
  OutPutFrm.ShowModal;
*)
end;

procedure TBNestedAForm.ShowResults(Sender: TObject);
VAR
  outvalue : string;
  F, PF : double;
begin
  OutPutFrm.RichEdit.Lines.Add('ANOVA TABLE');
  OutPutFrm.RichEdit.Lines.Add('SOURCE     D.F.        SS        MS        F         PROB.');
  if RandomBChk.Checked then
     begin
       F := MSA / MSB;
       PF := probf(F,dfA,dfBwA);
     end else
     begin
       F := MSA / MSW;
       PF := probf(F,dfA,dfwcell);
     end;
  outvalue := format('A         %4D  %10.3f%10.3f%10.3f%10.3f',[dfA,SSA,MSA,F,PF]);
  OutPutFrm.RichEdit.Lines.Add(outvalue);
  F := MSB / MSW;
  PF := probf(F,dfBwA,dfwcell);
  outvalue := format('B(W)      %4D  %10.3f%10.3f%10.3f%10.3f',[dfBwA,SSB,MSB,F,PF]);
  OutPutFrm.RichEdit.Lines.Add(outvalue);
  outvalue := format('w.cells   %4D  %10.3f%10.3f',[dfwcell,SSW,MSW]);
  OutPutFrm.RichEdit.Lines.Add(outvalue);
  outvalue := format('Total     %4D  %10.3f',[dftotal,SSTot]);
  OutPutFrm.RichEdit.Lines.Add(outvalue);
  OutPutFrm.ShowModal;
end;

procedure TBNestedAForm.ReleaseMemory(Sender: TObject);
begin
  ASDs := nil;
  BCount := nil;
  ACount := nil;
  BMeans := nil;
  AMeans := nil;
  BSumSqr := nil;
  ASumSqr := nil;
  BSS := nil;
  ASS := nil;
  CellSDs := nil;
  CellMeans := nil;
  CellCount := nil;
  SumSqr := nil;
  SS := nil;
end;

procedure TBNestedAForm.TwoWayPlot(Sender: TObject);
VAR
  plottype, i, j : integer;
  maxmean, XBar : double;
  title, setstring : string;
  XValue : DblDyneVec;
begin
  maxmean := -1000.0;
  SetLength(XValue,NoALevels+NoBLevels);
  setstring := 'FACTOR A';
  plottype := OptionsBox.ItemIndex + 1;
  if plottype = 3 then plottype := 1
  else if plottype = 4 then plottype := 2
  else if plottype = 1 then plottype := 9
  else if plottype = 2 then plottype := 10;
  GraphFrm.SetLabels[1] := setstring;
  SetLength(GraphFrm.Xpoints,1,NoALevels);
  SetLength(GraphFrm.Ypoints,1,NoALevels);
  for i := 1 to NoALevels do
      begin
        GraphFrm.Ypoints[0,i-1] := AMeans[i-1];
        if AMeans[i-1] > maxmean then maxmean := AMeans[i-1];
        XValue[i-1] := MinA + i -1;
        GraphFrm.Xpoints[0,i-1] := XValue[i-1];
      end;
  GraphFrm.nosets := 1;
  GraphFrm.nbars := NoALevels;
  GraphFrm.Heading := FactorA;
  title := FactorA + ' Group Codes';
  GraphFrm.XTitle := title;
  GraphFrm.YTitle := 'Mean';
  GraphFrm.barwideprop := 0.5;
  GraphFrm.AutoScale := false;
  GraphFrm.miny := 0.0;
  GraphFrm.maxy := maxmean;
  GraphFrm.GraphType := plottype;
  GraphFrm.BackColor := clYellow;
  GraphFrm.WallColor := clBlack;
  GraphFrm.FloorColor := clLtGray;
  GraphFrm.ShowBackWall := true;
  GraphFrm.ShowModal;
  GraphFrm.Xpoints := nil;
  GraphFrm.Ypoints := nil;

  // Factor B next
  setstring := 'FACTOR B';
  GraphFrm.SetLabels[1] := setstring;
  maxmean := 0.0;
  SetLength(GraphFrm.Xpoints,1,NoBLevels);
  SetLength(GraphFrm.Ypoints,1,NoBLevels);
  for i := 1 to NoBLevels do
      begin
        GraphFrm.Ypoints[0,i-1] := BMeans[i-1];
        if BMeans[i-1] > maxmean then maxmean := BMeans[i-1];
        XValue[i-1] := MinB + i - 1;
        GraphFrm.Xpoints[0,i-1] := XValue[i-1];
      end;
  GraphFrm.nosets := 1;
  GraphFrm.nbars := NoBLevels;
  GraphFrm.Heading := 'FACTOR B';
  title := FactorB + ' Group Codes';
  GraphFrm.XTitle := title;
  GraphFrm.YTitle := 'Mean';
  GraphFrm.barwideprop := 0.5;
  GraphFrm.AutoScale := false;
  GraphFrm.miny := 0.0;
  GraphFrm.maxy := maxmean;
  GraphFrm.GraphType := plottype;
  GraphFrm.BackColor := clYellow;
  GraphFrm.WallColor := clBlack;
  GraphFrm.FloorColor := clLtGray;
  GraphFrm.ShowBackWall := true;
  GraphFrm.ShowModal;
  GraphFrm.Xpoints := nil;
  GraphFrm.Ypoints := nil;
  XValue := nil;
end;

initialization
  {$I bnestaunit.lrs}

end.