{ Test file: ABNested.laz (imported from OpenStat sample data zip file)
    Dependent: Dep
    Factor A : A
    Factor B : B
}

unit BNestAUnit;

{$MODE objfpc}{$H+}
{$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, LCLVersion,
  StdCtrls, Buttons, ExtCtrls, ComCtrls,
  TACustomSeries,
  MainUnit, Globals, ReportFrameUnit, BasicStatsReportAndChartFormUnit;

type

  { TBNestedAForm }

  TBNestedAForm = class(TBasicStatsReportAndChartForm)
    ACodesEdit: TEdit;
    AInBtn: TBitBtn;
    AOutBtn: TBitBtn;
    BCodesEdit: TEdit;
    BInBtn: TBitBtn;
    BOutBtn: TBitBtn;
    Plot3DChk: TCheckBox;
    PlotOptionsGroup: TGroupBox;
    RandomBChk: TCheckBox;
    DepInBtn: TBitBtn;
    DepOutBtn: TBitBtn;
    DepEdit: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    MeansPage: TTabSheet;
    ShowPlotsChk: TCheckBox;
    VarList: TListBox;
    procedure AInBtnClick(Sender: TObject);
    procedure AOutBtnClick(Sender: TObject);
    procedure BInBtnClick(Sender: TObject);
    procedure BOutBtnClick(Sender: TObject);
    procedure DepInBtnClick(Sender: TObject);
    procedure DepOutBtnClick(Sender: TObject);
    procedure Plot3DChkChange(Sender: TObject);
    procedure ShowPlotsChkChange(Sender: TObject);
    procedure VarListDblClick(Sender: TObject);
    procedure VarListSelectionChange(Sender: TObject; {%H-}User: boolean);

  private
    SS, SumSqr, CellMeans, CellSDs : DblDyneMat;
    CellCount : IntDyneMat;
    ASS, BSS, ASumSqr, BSumSqr, AMeans, BMeans, ASDs : DblDyneVec;
    ACount, BCount : IntDyneVec;
    MinA, MinB, MaxA, MaxB, NoALevels, NoBLevels: integer;
    SSTot, SumSqrTot, TotMean, MSTot, SSA, MSA, SSB, MSB, SSW, MSW : double;
    TotN, dfA, dfBwA, dfwcell, dftotal : integer;

    function GetVariables(out AValues, BValues, DepValues: DblDyneVec): Boolean;
    procedure GetMemory;
    procedure GetSums(const AValues, BValues, DepValues: DblDyneVec);
    procedure ShowMeans;
    procedure GetResults;
    procedure ShowResults;
    procedure ReleaseMemory;
    procedure TwoWayPlot;

  private
    FMeansReportFrame: TReportFrame;
    FChartCombobox: TCombobox;
    FSeries: TChartSeries;
    procedure PopulateChartCombobox;
    procedure SelectPlot(Sender: TObject);

  protected
    procedure AdjustConstraints; override;
    procedure Compute; override;
    procedure UpdateBtnStates; override;
    function Validate(out AMsg: String; out AControl: TWinControl): Boolean; override;
		
  public
    constructor Create(AOwner: TComponent); override;
    procedure Reset; override;
  end; 

var
  BNestedAForm: TBNestedAForm;

implementation

{$R *.lfm}

uses
  Math,
  TAChartUtils, TACustomSource, TALegend, TASeries,
  Utils, MathUnit, MatrixUnit, GridProcs, ChartFrameUnit;

{ TBNestedAForm }

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

  FMeansReportFrame := TReportFrame.Create(MeansPage);
  FMeansReportFrame.Parent := MeansPage;
  FMeansReportFrame.Align := alClient;
  InitToolbar(FMeansReportFrame.ReportToolbar, tpTop);
  MeansPage.PageIndex := 1;

  FChartFrame.Chart.Margins.Bottom := 0;
  FChartFrame.Chart.BottomAxis.AxisPen.Visible := true;
  FChartFrame.Chart.BottomAxis.ZPosition := 1;
  FChartFrame.Chart.BottomAxis.Grid.Visible := false;
  AddComboboxToToolbar(FChartFrame.ChartToolbar, 'Plots:', FChartCombobox);
  FChartCombobox.OnSelect := @SelectPlot;

  PageControl.ActivePageIndex := 0;
end;


procedure TBNestedAForm.AdjustConstraints;
begin
  inherited;

  ParamsPanel.Constraints.MinWidth := Max(
    4*CloseBtn.Width + 3*CloseBtn.BorderSpacing.Left,
    Max(Label3.Width, RandomBChk.Width) * 2 + AInBtn.Width + 2*VarList.BorderSpacing.Right
  );
  ParamsPanel.Constraints.MinHeight := RandomBChk.Top + RandomBChk.Height +
    VarList.BorderSpacing.Bottom + PlotOptionsGroup.Height +
    ButtonBevel.Height + CloseBtn.Height + CloseBtn.BorderSpacing.Top;
end;


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


procedure TBNestedAForm.AOutBtnClick(Sender: TObject);
begin
  if ACodesEdit.Text <> '' then
  begin
    VarList.Items.Add(ACodesEdit.Text);
    ACodesEdit.Text := '';
  end;
  UpdateBtnStates;
end;


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


procedure TBNestedAForm.BOutBtnClick(Sender: TObject);
begin
  if BCodesEdit.Text <> '' then
  begin
    VarList.Items.Add(BCodesEdit.Text);
    BCodesEdit.Text := '';
  end;
  UpdateBtnStates;
end;


procedure TBNestedAForm.Compute;
var
  dataA: DblDyneVec = nil;
  dataB: DblDyneVec = nil;
  dataDep: DblDyneVec = nil;
begin
  if GetVariables(dataA, dataB, dataDep) then
  begin
    GetMemory;
    GetSums(dataA, dataB, dataDep);
    ShowMeans;
    GetResults;
    ShowResults;
    TwoWayPlot;
    ReleaseMemory;
  end;
end;


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


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


procedure TBNestedAForm.Plot3DChkChange(Sender: TObject);
begin
  if FSeries is TBarSeries then
  begin
    if Plot3dChk.Checked then
      TBarSeries(FSeries).Depth := 20
    else
      TBarSeries(FSeries).Depth := 0;
  end;
end;


procedure TBNestedAForm.ShowPlotsChkChange(Sender: TObject);
begin
  ChartPage.TabVisible := ShowPlotsChk.Checked;
  Plot3DChk.Enabled := ShowPlotsChk.Checked;
end;


procedure TBNestedAForm.GetMemory;
begin
  SS := MatCreate(NoBLevels,NoALevels);
  SumSqr := MatCreate(NoBLevels,NoALevels);
  CellCount := IntMatCreate(NoBLevels,NoALevels);
  CellMeans := MatCreate(NoBLevels,NoALevels);
  CellSDs := MatCreate(NoBLevels,NoALevels);

  ASS := VecCreate(NoALevels);
  BSS := VecCreate(NoBLevels);
  ASumSqr := VecCreate(NoALevels);
  BSumSqr := VecCreate(NoBLevels);
  AMeans := VecCreate(NoALevels);
  BMeans := VecCreate(NoBLevels);
  ACount := IntVecCreate(NoALevels);
  BCount := IntVecCreate(NoBLevels);
  ASDs := VecCreate(NoALevels);
end;


procedure TBNestedAForm.GetResults;
VAR
  temp, constant : double;
  NoBLevelsInA, BLevCount, i, j, celln : integer;
begin
  celln := 0;
  for i := 0 to NoALevels-1 do
    for j := 0 to NoBLevels-1 do
      if CellCount[j,i] > celln then celln := CellCount[j,i];

  // Assume all cells have same n size
  // Get number of levels in A
  BLevCount := 0;
  for i := 0 to NoALevels-1 do
  begin
    NoBLevelsInA := 0;
    for j := 0 to NoBLevels-1 do
      if CellCount[j,i] > 0 then NoBLevelsInA := NoBLevelsInA + 1;
    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
    for j := 0 to NoBLevels-1 do
      if CellCount[j,i] > 0 then SSB := SSB + (SumSqr[j,i] / CellCount[j,i]);
  SSB := SSB - temp;

  MSB := SSB / dfBwA;
  SSW := SSTot - SSA - SSB;
  MSW := SSW / dfwcell;
end;


procedure TBNestedAForm.GetSums(const AValues, BValues, DepValues: DblDyneVec);
var
  AIndex, BIndex, i, j: integer;
  YValue, YValueSqr: double;
begin
  // Accumulate sums and sums of squared values
  SSTot := 0;
  SumSqrTot := 0;
  TotN := 0;
  for i := 0 to High(DepValues) do
  begin
    AIndex := round(AValues[i]) - MinA;
    BIndex := round(BValues[i]) - MinB;
    YValue := DepValues[i];
    YValueSqr := YValue * YValue;
{
         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] + YValueSqr;
    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] + YValueSqr;
    BSS[BIndex] := BSS[BIndex] + YValueSqr;
    ASumSqr[AIndex] := ASumSqr[AIndex] + YValue;
    BSumSqr[BIndex] := BSumSqr[BIndex] + YValue;
    SSTot := SSTot + YValueSqr;
    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;


function TBNestedAForm.GetVariables(
  out AValues, BValues, DepValues: DblDyneVec): Boolean;
var
  ColNoSelected: IntDyneVec = nil;
  mn, mx: Double;
  msg: String;
begin
  Result := false;

  SetLength(ColNoSelected, 3);
  ColNoSelected[0] := GetVariableIndex(OS3MainFrm.DataGrid, ACodesEdit.Text);   // A
  ColNoSelected[1] := GetVariableIndex(OS3MainFrm.DataGrid, BCodesEdit.Text);   // B
  ColNoSelected[2] := GetVariableindex(OS3MainFrm.DataGrid, DepEdit.Text);      // Dependent

  AValues := CollectVecValues(OS3MainFrm.DataGrid, ColNoSelected[0], ColNoSelected);
  if not CheckFactorCodes(ACodesEdit.Text, AValues, msg) then
  begin
    ErrorMsg(msg);
    exit;
  end;

  BValues := CollectVecValues(OS3MainFrm.DataGrid, ColNoSelected[1], ColNoSelected);
  if not CheckFactorCodes(BCodesEdit.Text, BValues, msg) then
  begin
    ErrorMsg(msg);
    exit;
  end;

  DepValues := CollectVecValues(OS3MainFrm.DataGrid, ColNoSelected[2], ColNoSelected);

  if (Length(DepValues) <> Length(AValues)) or
     (Length(DepValues) <> Length(BValues)) then
  begin
    ErrorMsg('All variables must contain equal amounts of cases.');
    exit;
  end;

  VecMaxMin(AValues, mx, mn);
  MaxA := round(mx);
  MinA := round(mn);

  VecMaxMin(BValues, mx, mn);
  MaxB := round(mx);
  MinB := round(mn);

  NoALevels := MaxA - MinA + 1;
  NoBLevels := MaxB - MinB + 1;

  Result := true;
end;


procedure TBNestedAForm.ShowMeans;
var
  lReport: TStrings;
  i, j: integer;
begin
  lReport := TStringList.Create;
  try
    lReport.Add('NESTED ANOVA by Bill Miller');
    lReport.Add('');
    lReport.Add('File analyzed: %s', [OS3MainFrm.FileNameEdit.Text]);
    lReport.Add('Factor A:      %s', [ACodesEdit.Text]);
    lReport.Add('Factor B:      %s', [BCodesEdit.Text]);
    lReport.Add('');
    lReport.Add('CELL MEANS');
    lReport.Add('-------------------------------------------');
    lReport.Add('A LEVEL   B LEVEL      MEAN       STD.DEV. ');
    lReport.Add('-------   -------   ----------   ----------');
    for i := 0 to NoALevels-1 do
      for j := 0 to NoBLevels-1 do
        if CellCount[j,i] > 0 then
          lReport.Add('%5d     %5d     %10.3f   %10.3f', [i+MinA, j+MinB, CellMeans[j,i], CellSDs[j,i]]);
    lReport.Add('-------------------------------------------');
    lReport.Add('');
    lReport.Add('A MARGIN MEANS');
    lReport.Add('---------------------------------');
    lReport.Add('A LEVEL      MEAN       STD.DEV. ');
    lReport.Add('-------   ----------   ----------');
    for i := 0 to NoALevels-1 do
      lReport.Add('%5d     %10.3f   %10.3f', [i+MinA, AMeans[i], ASDs[i]]);
    lReport.Add('---------------------------------');
    lReport.Add('');
    lReport.Add('GRAND MEAN: %0.3f', [TotMean]);
    lReport.Add('');
    lReport.Add('');

    FMeansReportFrame.DisplayReport(lReport);
  finally
    lReport.Free;
  end;
end;


procedure TBNestedAForm.ShowResults;
var
  F, PF: double;
  lReport: TStrings;
begin
  lReport := TStringList.Create;
  try
    lReport.Add('NESTED ANOVA by Bill Miller');
    lReport.Add('');
    lReport.Add('File analyzed: %s', [OS3MainFrm.FileNameEdit.Text]);
    lReport.Add('Factor A:      %s', [ACodesEdit.Text]);
    lReport.Add('Factor B:      %s', [BCodesEdit.Text]);
    lReport.Add('');
    lReport.Add('ANOVA TABLE');
    lReport.Add('-------------------------------------------------------------');
    lReport.Add('SOURCE     D.F.      SS          MS          F        PROB.  ');
    lReport.Add('---------  ----  ----------  ----------  ---------  ---------');

    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;
    lReport.Add('A          %4d  %10.3f  %10.3f  %9.3f  %9.3f', [dfA, SSA, MSA, F, PF]);

    F := MSB / MSW;
    PF := ProbF(F,dfBwA,dfwcell);
    lReport.Add('B(W)       %4d  %10.3f  %10.3f  %9.3f  %9.3f', [dfBwA, SSB, MSB, F, PF]);

    lReport.Add('w.cells    %4d  %10.3f  %10.3f',                 [dfwcell, SSW, MSW]);
    lReport.Add('Total      %4d  %10.3f',                         [dftotal, SSTot]);
    lReport.Add('-------------------------------------------------------------');

    FReportFrame.DisplayReport(lReport);
  finally
    lReport.Free;
  end;
end;


procedure TBNestedAForm.PopulateChartCombobox;
var
  idx: Integer;
begin
  idx := FChartCombobox.ItemIndex;

  FChartCombobox.Items.Clear;
  FChartCombobox.Items.Add(ACodesEdit.Text);
  FChartCombobox.Items.Add(BCodesEdit.Text);

  FChartCombobox.ItemIndex := EnsureRange(idx, 0, FChartCombobox.Items.Count-1);
end;


procedure TBNestedAForm.ReleaseMemory;
begin
  ASDs := nil;
  BCount := nil;
  ACount := nil;
//  BMeans := nil;  // needed for plotting
//  AMeans := nil;
  BSumSqr := nil;
  ASumSqr := nil;
  BSS := nil;
  ASS := nil;
  CellSDs := nil;
  CellMeans := nil;
  CellCount := nil;
  SumSqr := nil;
  SS := nil;
end;


procedure TBNestedAForm.Reset;
begin
  inherited;

  if FMeansReportFrame <> nil then
    FMeansReportFrame.Clear;
  if FChartCombobox <> nil then
    FChartCombobox.Items.Clear;

  ACodesEdit.Clear;
  BCodesEdit.Clear;
  DepEdit.Clear;

  CollectVariableNames(OS3MainFrm.DataGrid, VarList.Items);
end;


procedure TBNestedAForm.SelectPlot(Sender: TObject);
var
  i: Integer;
begin
  FSeries.Clear;

  case FChartComboBox.ItemIndex of
    0: begin  // Plot means vs factor A
         for i := 0 to NoALevels-1 do
           FSeries.AddXY(MinA + i, AMeans[i], IntToStr(MinA + i));
         FChartFrame.SetXTitle(ACodesEdit.Text + ' codes');
         FChartFrame.SetTitle('Factor ' + ACodesEdit.Text);
       end;
    1: begin // Plot means vs factor B
         for i := 0 to NoBLevels-1 do
           FSeries.AddXY(MinB + i, BMeans[i], IntToStr(MinB + i));
         FChartFrame.SetXTitle(BCodesEdit.Text + ' codes');
         FChartFrame.SetTitle('Factor ' + BCodesEdit.Text);
       end;
  end;

  FChartFrame.Chart.BottomAxis.Marks.Source := FSeries.Source;
  FChartFrame.Chart.BottomAxis.Marks.Style := smsLabel;
  FChartFrame.Chart.Legend.Visible := FSeries.Source.YCount > 1;

  FChartFrame.UpdateBtnStates;
end;


procedure TBNestedAForm.TwoWayPlot;
begin
  if not ShowPlotsChk.Checked then
  begin
    ChartPage.TabVisible := false;
    exit;
  end;

  FChartFrame.Clear;   // this destroys the series
  FChartFrame.SetYTitle('Mean');

  FSeries := FChartFrame.PlotXY(ptBars, nil, nil, nil, nil, '', DATA_Colors[0]);
  with TBarSeries(FSeries) do
  begin
    Stacked := false;
    {$IF LCL_FullVersion >= 2010000}
    DepthBrightnessDelta := -30;
    {$IFEND}
  end;

  if Plot3DChk.Checked then
    FSeries.Depth := 20;

  FChartCombobox.Parent.Left := 0;
  PopulateChartCombobox;
  SelectPlot(nil);

  ChartPage.TabVisible := true;
end;


function TBNestedAForm.Validate(out AMsg: String; out AControl: TWinControl): Boolean;
begin
  Result := false;

  if DepEdit.Text = '' then
  begin
    AMsg := 'Dependent variable not specified.';
    AControl := VarList;
    exit;
  end;

  if ACodesEdit.Text = '' then
  begin
    AMsg := 'Factor A variable not specified.';
    AControl := VarList;
    exit;
  end;

  if BCodesEdit.Text = '' then
  begin
    AMsg := 'Factor B variable not specified.';
    AControl := VarList;
    exit;
  end;

  Result := true;
end;


procedure TBNestedAForm.VarListDblClick(Sender: TObject);
var
  index: Integer;
  s: String;
begin
  index := VarList.ItemIndex;
  if index > -1 then
  begin
    s := VarList.Items[index];
    if DepEdit.Text = '' then
      DepEdit.Text := s
    else
    if ACodesEdit.Text = '' then
      ACodesEdit.Text := s
    else
    if BCodesEdit.Text = '' then
      BCodesEdit.Text := s;
    VarList.Items.Delete(index);
    UpdateBtnStates;
  end;
end;


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


procedure TBNestedAForm.UpdateBtnStates;
var
  lSelected: Boolean;
begin
  inherited;
	
  if FMeansReportFrame <> nil then
    FMeansReportFrame.UpdateBtnStates;

  lSelected := AnySelected(VarList);
  AInBtn.Enabled := lSelected and (ACodesEdit.Text = '');
  BInBtn.Enabled := lSelected and (BCodesEdit.Text = '');
  DepInBtn.Enabled := lSelected and (DepEdit.Text = '');
  AOutBtn.Enabled := (ACodesEdit.Text <> '');
  BOutBtn.Enabled := (BCodesEdit.Text <> '');
  DepOutBtn.Enabled := (DepEdit.Text <> '');
end;

end.