// Use "twoway.laz" for testing

unit BreakDownUnit;

{$mode objfpc}{$H+}

interface

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

type

  { TBreakDownFrm }

  TBreakDownFrm = class(TBasicStatsReportForm)
    InBtn: TBitBtn;
    OutBtn: TBitBtn;
    PageControl: TPageControl;
    SelVarInBtn: TBitBtn;
    SelVarOutBtn: TBitBtn;
    CheckGroup1: TCheckGroup;
    DepVar: TEdit;
    AvailLabel: TLabel;
    AnalLabel: TLabel;
    SelLabel: TLabel;
    SelList: TListBox;
    BreakDownPage: TTabSheet;
    AnovaPage: TTabSheet;
    VarList: TListBox;
    procedure InBtnClick(Sender: TObject);
    procedure OutBtnClick(Sender: TObject);
    procedure SelListDblClick(Sender: TObject);
    procedure SelListSelectionChange(Sender: TObject; {%H-}User: boolean);
    procedure SelVarInBtnClick(Sender: TObject);
    procedure SelVarOutBtnClick(Sender: TObject);
    procedure VarListDblClick(Sender: TObject);
    procedure VarListSelectionChange(Sender: TObject; {%H-}User: boolean);

  private
    FANOVAReportFrame: TReportFrame;

    procedure ANOVA(ListSize: Integer; Freq, Selected, Minimum, Subscript,
      Levels, Displace: IntDyneVec; Mean, SS: DblDyneVec; AReport: TStrings);
    procedure GetLevels(const AMinimum, AMaximum, ALevels, ADisplace: IntDyneVec);
    procedure GetMinMax(const AMinimum, AMaximum, ASelected: IntDyneVec);
    function Index_Pos(const X, ADisplace: IntDyneVec; AListSize: integer): Integer;
  
  protected
    procedure AdjustConstraints; override;
    procedure Compute; override;
    procedure UpdateBtnStates; override;

  public
    constructor Create(AOwner: TComponent); override;		
    procedure Reset; override;
  end; 

var
  BreakDownFrm: TBreakDownFrm;



implementation

{$R *.lfm}

uses
  Math,
  Utils, MathUnit;


{ TBreakDownFrm }

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

  FReportFrame.Parent := BreakDownPage;

  FANOVAReportFrame := TReportFrame.Create(ANOVAPage);
  with FANOVAReportFrame do
  begin
    Parent := ANOVAPage;
    Align := alClient;
  end;

  PageControl.ActivePage := BreakdownPage;

  Reset;
end;


procedure TBreakDownFrm.AdjustConstraints;
begin
  inherited;

  ParamsPanel.Constraints.MinWidth := Max(
    4*CloseBtn.Width + 3*CloseBtn.BorderSpacing.Left,
    SelLabel.Width * 2 + InBtn.Width + VarList.BorderSpacing.Right * 2);
  ParamsPanel.Constraints.MinHeight := InBtn.Top +
    4*InBtn.Height + 3*OutBtn.BorderSpacing.Bottom +
    CheckGroup1.BorderSpacing.Top + CheckGroup1.Height + ButtonBevel.Height +
    CloseBtn.BorderSpacing.Top + CloseBtn.Height;

  Constraints.MinWidth := ParamsPanel.Constraints.MinWidth + 300;
  Constraints.MinHeight := ParamsPanel.Constraints.MinHeight + ParamsPanel.BorderSpacing.Left*2;
  if Width < Constraints.MinWidth then Width := 1;    // enforce constraints
  if Height < Constraints.MinHeight then Height := 1;
end;


procedure TBreakDownFrm.ANOVA(ListSize: Integer; Freq, Selected, Minimum,
  Subscript, Levels, Displace: IntDyneVec; Mean, SS: DblDyneVec; AReport: TStrings);
var
  i, j: Integer;
  ptr1, ptr2: Integer;
  MSB, MSW, SSB, SST, SSW: Double;
  grandSum: Integer;
  grandSumX, grandSumX2: Double;
  DF1, DF2: Double;
  F, Fprob: Double;
  index: Integer;
  length_array: Integer;
begin
  AnovaPage.Caption := 'Analysis of Variance';
  AnovaPage.TabVisible := true;

  AReport.Add('ANALYSES OF VARIANCE SUMMARY TABLES');
  AReport.Add('');

  length_array := Length(Freq) - 1;  // freq is set by Setlength(freq, length_array+1);
  ptr1 := ListSize - 1;
  ptr2 := ListSize;
  for i := 1 to ListSize do subscript[i-1] := 1;
  SSB := 0.0;
  SSW := 0.0;
  MSB := 0.0;
  MSW := 0.0;
  grandsum := 0;
  grandsumx := 0.0;
  grandsumx2 := 0.0;
  DF1 := 0.0;
  DF2 := 0.0;

  while true do
  begin
    index := Index_Pos(Subscript, Displace, ListSize);
    if Freq[index] > 0 then
    begin
      AReport.Add('Variable levels: ');
      for i := 1 to  ListSize do
      begin
        j := Selected[i-1];
        AReport.Add('%-10s  level %d', [
          OS3MainFrm.DataGrid.Cells[j,0], Minimum[i-1] + subscript[i-1] - 1
        ]);
      end;
      AReport.Add('');

      // build sumsof squares for this set
      DF1  := DF1 + 1;
      DF2  := DF2 + Freq[index] - 1;
      grandsum := grandsum + Freq[index];
      grandsumx := grandsumx + mean[index];
      grandsumx2 := grandsumx2 + SS[index];
      SSW := SSW + SS[index] - (mean[index] * mean[index] / Freq[index]);
    end;
    subscript[ptr2-1] := subscript[ptr2-1] + 1;

    if subscript[ptr2-1] <= levels[ptr2-1] then
      Continue;  // Return to start

    if (grandsum > 0.0) and (DF1 > 1) and (DF2 > 1) and (SSW > 0.0) then
    begin
      // build and show anova table
      SST := grandsumx2 - (grandsumx * grandsumx / grandsum);
      SSB := SST - SSW;
      DF1 := DF1 - 1.0; // no. of groups - 1
      MSB := SSB / DF1;
      MSW := SSW / DF2;
      F := MSB / MSW;
      FProb := ProbF(F, DF1, DF2);  // wp: was "probf(DF1,DF2,F)";
      AReport.Add('SOURCE    D.F.     SS        MS        F      Prob.>F');
      AReport.Add('--------  ----  --------  --------  --------  --------');
      AReport.Add('GROUPS    %4.0f  %8.2f  %8.2f  %8.3f  %8.4f', [DF1, SSB, MSB, F, FProb]);
      AReport.Add('WITHIN    %4.0f  %8.2f  %8.2f', [DF2, SSW, MSW]);
      AReport.Add('TOTAL     %4d  %8.2f', [grandsum-1, SST]);
    end else
      AReport.Add('Insufficient data for ANOVA');

    AReport.Add('');
    AReport.Add(DIVIDER_AUTO);
    AReport.Add('');

    SSB := 0.0;
    SSW := 0.0;
    MSB := 0.0;
    MSW := 0.0;
    grandsum := 0;
    grandsumx := 0.0;
    grandsumx2 := 0.0;
    DF1 := 0.0;
    DF2 := 0.0;

    if ptr1 < 1 then
      break;

    subscript[ptr1-1] := subscript[ptr1-1] + 1;
    if subscript[ptr1-1] > levels[ptr1-1] then
    begin
      repeat
        dec(ptr1);
        if ptr1 >= 1 then
        begin
          if subscript[ptr1-1] > levels[ptr1-1] then
            continue;
          inc(subscript[ptr1-1]);
          if subscript[ptr1-1] <= levels[ptr1-1] then
            break;
        end;
      until ptr1 < 1;
      if ptr1 < 1 then
        break;
    end;

    for i := ptr1+1 to ListSize do subscript[i-1] := 1;
    ptr1 := ListSize - 1;
    if ptr1 < 1 then
      break;
  end;

  // Calculate ANOVA for all cells
  AReport.Add('ANOVA FOR ALL CELLS');
  AReport.Add('');
  SST := 0.0;
  SSW := 0.0;
  DF2 := 0.0;
  DF1 := 0.0;
  grandsumx := 0.0;
  grandsum := 0;
  for i := 1 to length_array do
  begin
    if Freq[i] > 0 then
    begin
      SST  := SST + SS[i];
      grandsum := grandsum + Freq[i];
      grandsumx := grandsumx + mean[i];
      SSW := SSW + (SS[i] - sqr(mean[i]) / Freq[i]);
      DF1 := DF1 + 1.0;
      DF2 := DF2 + (Freq[i] - 1);
    end;
  end;

  if (DF1 > 1.0) and (DF2 > 1.0) and (SSW > 0.0) then
  begin
    SST := SST - sqr(grandsumx) / grandsum;
    SSB := SST - SSW;
    DF1 := DF1 - 1;
    MSB := SSB / DF1;
    MSW := SSW / DF2;
    F := MSB / MSW;
    FProb := ProbF(F, DF1, DF2);  // wp: was "probf(DF1, DF2, F)"
    AReport.Add('SOURCE    D.F.     SS        MS        F      Prob.>F');
    AReport.Add('--------  ----  --------  --------  --------  --------');
    AReport.Add('GROUPS    %4.0f  %8.2f  %8.2f  %8.3f  %8.4f', [DF1, SSB, MSB, F, FProb]);
    AReport.Add('WITHIN    %4.0f  %8.2f  %8.2f', [DF2, SSW, MSW]);
    AReport.Add('TOTAL     %4d  %8.2f', [grandsum-1, SST]);
    AReport.Add('');
    AReport.Add('FINISHED');
  end else
  begin
    AReport.Add('Only 1 group.  No ANOVA possible.');
  end;
end;


procedure TBreakDownFrm.Compute;
label
  Label1, Label3, Label4, NextStep;
var
  index, ListSize, length_array : integer;
  ptr1, ptr2, sum, grandsum : integer;
  xsumtotal, xsqrtotal, grandsumx, grandsumx2, value, SD : double;
  cellstring : string;
  outline : string;
  valstr : string;
  dataread : boolean;

  selected : IntDyneVec = nil;
  freq: IntDyneVec = nil;
  minimum: IntDyneVec = nil;
  maximum: IntDyneVec = nil;
  levels: IntDyneVec = nil;
  displace: IntDyneVec = nil;
  subscript: IntDyneVec = nil;
  mean: DblDyneVec = nil;
  variance: DblDyneVec = nil;
  stddev: DblDyneVec = nil;
  SS: DblDyneVec = nil;

  X: Integer;
  i, j: integer;
  dependentVar, NoSelected: Integer;
  tempval: string;
  lReport: TStrings;
begin
  inherited;
	
  // Identify columns of variables to analyze and the dependent var.
  NoSelected := SelList.Items.Count;

  if NoSelected = 0 then
  begin
    ErrorMsg('No variables selected.');
    exit;
  end;

  // Get column no. of dependent variable
  dependentVar := 0;
  cellstring := DepVar.Text;
  for i := 1 to NoVariables do
    if cellstring = OS3MainFrm.DataGrid.Cells[i,0] then dependentvar := i;

  if dependentVar = 0 then
  begin
    ErrorMsg('Continuous variable is not specified.');
    exit;
  end;

  // Get selected variables
  SetLength(selected, NoVariables);
  for i := 1 to NoSelected do
  begin
    cellstring := SelList.Items[i-1];
    for j := 1 to NoVariables do
      if cellstring = OS3MainFrm.DataGrid.Cells[j,0] then Selected[i-1] := j;
  end;
  Selected[NoSelected] := dependentvar;
  ListSize := NoSelected;

  // Get maximum and minimum levels in each variable
  SetLength(minimum, ListSize);
  SetLength(maximum, ListSize);
  GetMinMax(minimum, maximum, selected);

  // Calculate number of levels for each variable
  SetLength(levels, ListSize);
  SetLength(displace, ListSize);
  GetLevels(minimum, maximum, levels, displace);

  // Now, tabulate
  length_array := 1;
  for i := 0 to ListSize-1 do
    length_array := Length_array * levels[i];

  // initialize values
  SetLength(Freq, length_array+1);
  SetLength(mean, length_array+1);
  SetLength(variance, length_array+1);
  SetLength(Stddev, length_array+1);
  SetLength(SS, length_array+1);

  for i := 0 to length_array do
  begin
    Freq[i] := 0;
    mean[i] := 0.0;
    variance[i] := 0.0;
    Stddev[i] := 0.0;
    SS[i] := 0.0;
  end;

  // tabulate
  SetLength(subscript, ListSize);
  for i := 1 to NoCases do
  begin
    dataread := false;
    if GoodRecord(i, NoSelected, Selected) then
    begin
      for j := 1 to ListSize do
      begin
        index := Selected[j-1];
        X := round(StrToFLoat(OS3MainFrm.DataGrid.Cells[index,i]));
        X := X - Minimum[j-1] + 1;
        subscript[j-1] := X;
        dataread := true;
      end;
    end;
    if dataread then
    begin
      j := Index_Pos(subscript, displace, ListSize);
      Freq[j] := Freq[j] + 1;
      index := dependentVar;
      tempval := Trim(OS3MainFrm.DataGrid.Cells[index,i]);
      if tempval <> '' then
      begin
        value := StrToFloat(tempval);
        mean[j] := mean[j] + value;
        variance[j] := variance[j] + sqr(value);
      end;
    end;
  end;

  // setup the output
  lReport := TStringList.Create;
  try
    BreakdownPage.Caption := 'Breakdown Analysis';

    lReport.Add('BREAKDOWN ANALYSIS PROGRAM');
    lReport.Add('');
    lReport.Add('VARIABLE SEQUENCE FOR THE BREAKDOWN:');
    for i := 1 to ListSize do
    begin
      index := Selected[i-1];
      lReport.Add('%-10s (Variable %3d) Lowest level: %2d   Highest level: %2d', [
        OS3MainFrm.DataGrid.Cells[index,0],i, Minimum[i-1], Maximum[i-1]
      ]);
    end;
    lReport.Add('');

    // Breakdown the data
    ptr1 := ListSize - 1;
    ptr2 := ListSize;
    for i := 1 to ListSize do
      subscript[i-1] := 1;
    sum := 0;
    xsumtotal := 0.0;
    xsqrtotal := 0.0;
    grandsum := 0;
    grandsumx := 0.0;
    grandsumx2 := 0.0;

  Label1:
    index := Index_Pos(subscript, displace, ListSize);
    lReport.Add('Variable levels:');
    for i := 1 to ListSize do
    begin
      j := Selected[i-1];
      lReport.Add('%-10s  level %3d', [
        OS3MainFrm.DataGrid.Cells[j,0], Minimum[i-1] + subscript[i-1] - 1
      ]);
    end;
    lReport.Add('');

    sum := sum + Freq[index];
    xsumtotal := xsumtotal + mean[index];
    xsqrtotal := xsqrtotal + variance[index];

    lReport.Add(' Freq.      Mean    Std. Dev.');
    lReport.Add('--------  --------  ---------');
    //           xxxxxxx   xxxxxxxx  xxxxxxxx
    outline := Format('%7d', [Freq[index]]);
    if Freq[index] > 0 then
    begin
      valstr := Format('   %8.3f ',[mean[index] / Freq[index]]);
      outline := outline + valstr;
    end
    else
      outline := outline +'  ********  ';

    if Freq[index] > 1 then
    begin
      SS[index] := variance[index];
      variance[index] := variance[index] - (mean[index] * mean[index] / Freq[index]);
      variance[index] := variance[index] / (Freq[index] - 1);
      Stddev[index] := sqrt(variance[index]);
      valstr := Format('%8.3f ', [Stddev[index]]);
      outline := outline + valstr;
    end else
      outline := outline + '********';

    lReport.Add(outline);
    lReport.Add('');

    subscript[ptr2-1] := subscript[ptr2-1] + 1;
    if subscript[ptr2-1] <= levels[ptr2-1] then goto Label1;

    lReport.Add  ('Number of observations across levels: %8d',[sum]);
    if sum > 0 then
      lReport.Add('Mean across levels:                   %8.3f',[ xsumtotal / sum])
    else
      lReport.Add('Mean across levels:                   ********');

    if sum > 1 then
    begin
      SD := sqrt( (xsqrtotal - (xsumtotal * xsumtotal) / sum) / (sum - 1));
      lReport.Add('Std. Dev. across levels:              %8.3f', [SD]);
    end else
      lReport.Add('Std. Dev. across levels:              ********');

    lReport.Add('');
    lReport.Add(DIVIDER_AUTO);
//    lReport.Add('===============================================================');
    lReport.Add('');
    //OutputFrm.ShowModal;
    //OutputFrm.Clear;

    grandsum := grandsum + sum;
    grandsumx := grandsumx + xsumtotal;
    grandsumx2 := grandsumx2 + xsqrtotal;
    sum := 0;
    xsumtotal := 0.0;
    xsqrtotal := 0.0;
    if ptr1 < 1 then
      goto NextStep;

    subscript[ptr1-1] :=subscript[ptr1-1] + 1;
    if subscript[ptr1-1] <= levels[ptr1-1] then
      goto Label4;

  Label3:
    ptr1 := ptr1 - 1;
    if ptr1 < 1 then
      goto NextStep;
    if subscript[ptr1-1] > levels[ptr1-1] then
      goto Label3;

    subscript[ptr1-1] := subscript[ptr1-1] + 1;
    if subscript[ptr1-1] > levels[ptr1-1] then
      goto Label3;

  Label4:
    for i := ptr1+1 to ListSize do subscript[i-1] := 1;
    ptr1 := ListSize - 1;
    if ptr1 < 1 then goto
      NextStep;
    goto Label1;

  NextStep:
    lReport.Add  ('Grand number of observations across all categories: %8d', [grandsum]);
    if grandsum > 0 then
      lReport.Add('Overall Mean:                                       %8.3f', [grandsumx / grandsum]);
    if grandsum > 1 then
    begin
      SD := sqrt((grandsumx2 - sqr(grandsumx) / grandsum) / (grandsum - 1));
      lReport.Add('Overall Standard Deviation:                         %8.3f', [SD]);
    end;

    FReportFrame.DisplayReport(lReport);
    lReport.Clear;

    // Do ANOVA's if requested
    if CheckGroup1.Checked[0] then
    begin
      ANOVA(ListSize, Freq, Selected, Minimum, Subscript, Levels, Displace, Mean, SS, lReport);
      // Show ANOVA in pagecontrol
      FANovaReportFrame.DisplayReport(lReport);
    end;
    AnovaPage.TabVisible := CheckGroup1.Checked[0];

  finally
    lReport.Free;
  end;
end;


procedure TBreakDownFrm.GetLevels(const AMinimum, AMaximum, ALevels, ADisplace: IntDyneVec);
var
  i: Integer;
  listSize: Integer;
begin
  listSize := Length(AMaximum);

  for i := 0 to listSize-1 do
    ALevels[i] := AMaximum[i] - AMinimum[i] + 1;

  ADisplace[listSize-1] := 1;

  if listSize > 1 then
    for i := listSize-1 downto 1 do
      ADisplace[i-1] := ALevels[i] * ADisplace[i];
end;


procedure TBreakDownFrm.GetMinMax(const AMinimum, AMaximum, ASelected: IntDyneVec);
var
  i, j, index: Integer;
  listSize: Integer;
  NoSelected: Integer;
  X: Integer;
begin
  NoSelected := SelList.Count;
  listSize := Length(AMaximum);

  for i := 0 to listSize-1 do
  begin
    index := ASelected[i];
    AMinimum[i] := round(StrToFloat(OS3MainFrm.DataGrid.Cells[index, 1]));
    AMaximum[i] := AMinimum[i];
    for j := 1 to NoCases do
    begin
      if GoodRecord(j, NoSelected, ASelected) then
      begin
        X := round(StrToFloat(OS3MainFrm.DataGrid.Cells[index, j]));
        if X < AMinimum[i] then AMinimum[i] := X;
        if X > AMaximum[i] then AMaximum[i] := X;
      end;
    end;
  end;
end;


procedure TBreakDownFrm.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;


function TBreakDownFrm.Index_Pos(const X, ADisplace: IntDyneVec;
  AListSize: integer): integer;
var
  i: integer;
begin
  Result := X[AListSize-1];
  for i := 1 to AListSize - 1 do
    Result := Result + (X[i-1] - 1) * ADisplace[i-1];
end;


procedure TBreakDownFrm.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 TBreakDownFrm.Reset;
var
  i: integer;
begin
  inherited;

  VarList.Clear;
  SelList.Clear;
  DepVar.Text := '';
  InBtn.Enabled := true;
  OutBtn.Enabled := false;
  SelVarInBtn.Enabled := true;
  SelVarOutBtn.Enabled := false;
  for i := 1 to NoVariables do
    VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);

  if FAnovaReportFrame <> nil then
    FAnovaReportFrame.Clear;

  BreakdownPage.Caption := 'Report';
  AnovaPage.TabVisible := false;

  UpdateBtnStates;
end;


procedure TBreakDownFrm.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 TBreakDownFrm.SelListSelectionChange(Sender: TObject; User: boolean);
begin
  UpdateBtnStates;
end;


procedure TBreakDownFrm.SelVarInBtnClick(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 TBreakDownFrm.SelVarOutBtnClick(Sender: TObject);
begin
  if DepVar.Text <> '' then
    VarList.Items.Add(DepVar.Text);
  UpdateBtnStates;
end;


procedure TBreakDownFrm.UpdateBtnStates;
var
  lSelected: Boolean;
  i: Integer;
begin
  lSelected := false;
  for i := 0 to VarList.Count-1 do
    if VarList.Selected[i] then
    begin
      lSelected := true;
      break;
    end;
  InBtn.Enabled := lSelected;

  lSelected := false;
  for i := 0 to SelList.Count-1 do
    if SelList.Selected[i] then
    begin
      lSelected := true;
      break;
    end;
  OutBtn.Enabled := lSelected;

  SelVarInBtn.Enabled := (VarList.ItemIndex > -1) and (DepVar.Text = '');
  SelVarOutBtn.Enabled := (DepVar.Text <> '');

  if FAnovaReportFrame <> nil then
    FAnovaReportFrame.UpdateBtnStates;
end;


procedure TBreakDownFrm.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 TBreakDownFrm.VarListSelectionChange(Sender: TObject; User: boolean);
begin
  UpdateBtnStates;
end;


end.