unit BreakDownUnit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, ExtCtrls, Buttons, MainUnit, Globals, functionsLib, OutPutUnit,
  DataProcs, contexthelpunit;

type

  { TBreakDownFrm }

  TBreakDownFrm = class(TForm)
    HelpBtn: TButton;
    InBtn: TBitBtn;
    OutBtn: TBitBtn;
    SelVarInBtn: TBitBtn;
    SelVarOutBtn: TBitBtn;
    ResetBtn: TButton;
    CancelBtn: TButton;
    OKBtn: TButton;
    CheckGroup1: TCheckGroup;
    DepVar: TEdit;
    AvailLabel: TLabel;
    AnalLabel: TLabel;
    SelLabel: TLabel;
    ListBox1: TListBox;
    VarList: TListBox;
    procedure CancelBtnClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure HelpBtnClick(Sender: TObject);
    procedure InBtnClick(Sender: TObject);
    procedure OKBtnClick(Sender: TObject);
    procedure OutBtnClick(Sender: TObject);
    procedure ResetBtnClick(Sender: TObject);
    procedure SelVarInBtnClick(Sender: TObject);
    procedure SelVarOutBtnClick(Sender: TObject);
  private
    { private declarations }
    { Private declarations }
    Minimum, Maximum, levels, displace, subscript : IntDyneVec;
    Freq : IntDyneVec;
    Selected : IntDyneVec;
    mean, variance, Stddev, SS : DblDyneVec;
    index, NoSelected, ListSize, Dependentvar, X, length_array : integer;
    ptr1, ptr2, sum, grandsum : integer;
    xsumtotal, xsqrtotal, grandsumx, grandsumx2, value, SD : double;
    SST, SSW, SSB, MSW, MSB, F, FProb, DF1, DF2 : double;
    cellstring : string;
    outline : string;
    valstr : string;
    dataread : boolean;
    function Index_Pos(VAR X1 : IntDyneVec;
         VAR displace1 : IntDyneVec;
         ListSize1 : integer;
         Sender: TObject) : integer;

  public
    { public declarations }
  end; 

var
  BreakDownFrm: TBreakDownFrm;

implementation

{ TBreakDownFrm }

procedure TBreakDownFrm.ResetBtnClick(Sender: TObject);
var
   i : integer;

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

procedure TBreakDownFrm.SelVarInBtnClick(Sender: TObject);
var
   index1 : integer;
begin
     index1 := VarList.ItemIndex;
     DepVar.Text := VarList.Items.Strings[index1];
     SelVarInBtn.Visible := false;
     SelVarOutBtn.Visible := true;
end;

procedure TBreakDownFrm.SelVarOutBtnClick(Sender: TObject);
begin
     VarList.Items.Add(DepVar.Text);
     SelVarOutBtn.Visible := false;
     SelVarInBtn.Visible := true;
end;

procedure TBreakDownFrm.FormShow(Sender: TObject);
begin
     ResetBtnClick(self);
end;

procedure TBreakDownFrm.HelpBtnClick(Sender: TObject);
begin
  ContextHelpForm.HelpMessage((Sender as TButton).tag);
end;

procedure TBreakDownFrm.CancelBtnClick(Sender: TObject);
begin
     BreakDownFrm.Hide;
end;

procedure TBreakDownFrm.InBtnClick(Sender: TObject);
var
   index1, i : integer;

begin
     index1 := VarList.Items.Count;
     i := 0;
     while i < index1 do
     begin
         if (VarList.Selected[i]) then
         begin
            ListBox1.Items.Add(VarList.Items.Strings[i]);
            VarList.Items.Delete(i);
            index1 := index1 - 1;
            i := 0;
         end
         else i := i + 1;
     end;
     OutBtn.Visible := true;
     if VarList.Items.Count = 0 then InBtn.Visible := false;
end;

procedure TBreakDownFrm.OKBtnClick(Sender: TObject);
label Label1, Label3, Label4, NextStep, FirstOne, SecondOne, ThirdOne, LastStep;
var
   i, j : integer;
   tempval : string;

begin
     // Identify columns of variables to analyze and the dependent var.
    NoSelected := ListBox1.Items.Count;

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

    // Allocate heap
    SetLength(Minimum,NoVariables);
    SetLength(Maximum,NoVariables);
    SetLength(levels,NoVariables);
    SetLength(displace,NoVariables);
    SetLength(subscript,NoVariables);
    SetLength(Selected,NoVariables);

    // Get selected variables
    for i := 1 to NoSelected do
    begin
        cellstring := ListBox1.Items.Strings[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
    for i := 1 to ListSize do
    begin
        index := Selected[i-1];
        Minimum[i-1] := round(StrToFloat(OS3MainFrm.DataGrid.Cells[index,1]));
        Maximum[i-1] := Minimum[i-1];
        for j := 1 to NoCases do
        begin
            if GoodRecord(j,NoSelected,Selected) then
            begin
                X := round(StrToFloat(OS3MainFrm.DataGrid.Cells[index,j]));
                if X < Minimum[i-1] then Minimum[i-1] := X;
                if X > Maximum[i-1] then Maximum[i-1] := X;
            end;
        end;
    end;

    // Calculate number of levels for each variable
    for i := 1 to  ListSize do
        levels[i-1] := Maximum[i-1] - Minimum[i-1] + 1;
    displace[ListSize-1] := 1;
    if ListSize > 1 then
    begin
        for i := ListSize-1 downto 1 do
            displace[i-1] := levels[i] * displace[i];
    end;

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

    // 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
    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, self);
           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] + (value * value);
           end;
        end;
    end;

    // setup the output
    OutPutFrm.RichEdit.Clear;
//    OutPutFrm.RichEdit.ParaGraph.Alignment := taLeftJustify;
    OutPutFrm.RichEdit.Lines.Add('BREAKDOWN ANALYSIS PROGRAM');
    OutPutFrm.RichEdit.Lines.Add('');
    OutPutFrm.RichEdit.Lines.Add('VARIABLE SEQUENCE FOR THE BREAKDOWN:');
    for i := 1 to ListSize do
    begin
        index := Selected[i-1];
        outline := format('%-10s (Variable %3d) Lowest level = %2d Highest level = %2d',
           [OS3MainFrm.DataGrid.Cells[index,0],i, Minimum[i-1], Maximum[i-1]]);
        OutPutFrm.RichEdit.Lines.Add(outline);
    end;
    //OutPutFrm.ShowModal;

    // 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,self);
    OutPutFrm.RichEdit.Lines.Add('');
    OutPutFrm.RichEdit.Lines.Add('Variable levels: ');
    for i := 1 to ListSize do
    begin
        j := Selected[i-1];
        outline := format('%-10s level = %3d',
                [OS3MainFrm.DataGrid.Cells[j,0],
                Minimum[i-1] + subscript[i-1] - 1]);
        OutPutFrm.RichEdit.Lines.Add(outline);
    end;
    OutPutFrm.RichEdit.Lines.Add('');
    sum := sum + Freq[index];
    xsumtotal := xsumtotal + mean[index];
    xsqrtotal := xsqrtotal + variance[index];
    OutPutFrm.RichEdit.Lines.Add('Freq.     Mean     Std. Dev.');
    outline := format('%3d',[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 + '********';
    OutPutFrm.RichEdit.Lines.Add(outline);

    subscript[ptr2-1] := subscript[ptr2-1] + 1;
    if subscript[ptr2-1] <= levels[ptr2-1] then goto Label1;
    outline := format('Number of observations accross levels = %3d',[sum]);
    OutPutFrm.RichEdit.Lines.Add(outline);
    if sum > 0 then
    begin
        outline := format('Mean accross levels = %8.3f',[ xsumtotal / sum]);
        OutPutFrm.RichEdit.Lines.Add(outline);
    end
    else OutPutFrm.RichEdit.Lines.Add('Mean accross levels = ********');
    if sum > 1 then
    begin
        SD := sqrt( (xsqrtotal - (xsumtotal * xsumtotal) / sum) / (sum - 1));
        outline := format('Std. Dev. accross levels = %8.3f',[SD]);
        OutPutFrm.RichEdit.Lines.Add(outline);
    end
    else OutPutFrm.RichEdit.Lines.Add('Std. Dev. accross levels = *******');
    OutPutFrm.ShowModal;
    OutPutFrm.RichEdit.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:
    outline := format('Grand number of observations accross all categories = %3d',
      [grandsum]);
    OutPutFrm.RichEdit.Lines.Add(outline);
    if grandsum > 0 then
    begin
       outline := format('Overall Mean = %8.3f',[grandsumx / grandsum]);
       OutPutFrm.RichEdit.Lines.Add(outline);
    end;
    if grandsum > 1 then
    begin
       SD := sqrt((grandsumx2 - (grandsumx * grandsumx) / grandsum) / (grandsum - 1));
       outline := format('Overall standard deviation = %8.3f',[SD]);
       OutPutFrm.RichEdit.Lines.Add(outline);
    end;
    OutPutFrm.ShowModal;
    OutPutFrm.RichEdit.Clear;

     // Do ANOVA's if requested
    if CheckGroup1.CheckEnabled[0] then
    begin
        OutPutFrm.RichEdit.Lines.Add('ANALYSES OF VARIANCE SUMMARY TABLES');
        OutPutFrm.RichEdit.Lines.Add('');
        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;
FirstOne:
        index := Index_Pos(subscript,displace,ListSize, self);
        if Freq[index] > 0 then
        begin
            OutPutFrm.RichEdit.Lines.Add('Variable levels: ');
            for i := 1 to  ListSize do
            begin
                j := Selected[i-1];
                outline := format('%-10s level = %3d',
                    [OS3MainFrm.DataGrid.Cells[j,0], Minimum[i-1] + subscript[i-1] - 1]);
                OutPutFrm.RichEdit.Lines.Add(outline);
            end;
            OutPutFrm.RichEdit.Lines.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 goto FirstOne;

        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(DF1,DF2,F);
            OutPutFrm.RichEdit.Lines.Add('SOURCE    D.F.        SS        MS        F       Prob.>F');
            outline := format('GROUPS    %2.0f        %8.2f  %8.2f  %8.3f  %6.4f',
                [DF1,SSB,MSB,F,FProb]);
            OutPutFrm.RichEdit.Lines.Add(outline);
            outline := format('WITHIN    %2.0f        %8.2f  %8.2f',
                [DF2,SSW,MSW]);
            OutPutFrm.RichEdit.Lines.Add(outline);
            outline := format('TOTAL     %2d        %8.2f',[grandsum-1,SST]);
            OutPutFrm.RichEdit.Lines.Add(outline);
            OutPutFrm.ShowModal;
            OutPutFrm.RichEdit.Clear;
        end
        else begin
             OutPutFrm.RichEdit.Lines.Add('Insufficient data for ANOVA');
            OutPutFrm.ShowModal;
            OutPutFrm.RichEdit.Clear;
        end;
        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 goto LastStep;
        subscript[ptr1-1] := subscript[ptr1-1] + 1;
        if subscript[ptr1-1] <= levels[ptr1-1] then goto ThirdOne;
SecondOne:
        ptr1 := ptr1 - 1;
        if ptr1 < 1 then goto LastStep;
        if subscript[ptr1-1] > levels[ptr1-1] then goto SecondOne;
        subscript[ptr1-1] := subscript[ptr1-1] + 1;
        if subscript[ptr1-1] > levels[ptr1-1] then goto SecondOne;
ThirdOne:
        for i := ptr1+1 to ListSize do subscript[i-1] := 1;
        ptr1 := ListSize - 1;
        if ptr1 < 1 then goto LastStep;
        goto FirstOne;
LastStep:
        // do anova for all cells
        OutPutFrm.RichEdit.Lines.Add('ANOVA FOR ALL CELLS');
        OutPutFrm.RichEdit.Lines.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] - (mean[i] * 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 - (grandsumx * grandsumx / grandsum);
            SSB := SST - SSW;
            DF1 := DF1 - 1;
            MSB := SSB / DF1;
            MSW := SSW / DF2;
            F := MSB / MSW;
            FProb := probf(DF1, DF2, F);
            OutPutFrm.RichEdit.Lines.Add('SOURCE    D.F.        SS        MS        F       Prob.>F');
            outline := format('GROUPS    %2.0f        %8.2f  %8.2f  %8.3f  %6.4f',
                [DF1,SSB,MSB,F,FProb]);
            OutPutFrm.RichEdit.Lines.Add(outline);
            outline := format('WITHIN    %2.0f        %8.2f  %8.2f',
                [DF2,SSW,MSW]);
            OutPutFrm.RichEdit.Lines.Add(outline);
            outline := format('TOTAL     %2d        %8.2f',[grandsum-1,SST]);
            OutPutFrm.RichEdit.Lines.Add(outline);
            OutPutFrm.RichEdit.Lines.Add('FINISHED');
            OutPutFrm.ShowModal;
        end
        else
        begin
            OutPutFrm.RichEdit.Lines.Add('Only 1 group.  No ANOVA possible.');
            OutPutFrm.ShowModal;
        end;
    end;

    SS := nil;
    Stddev := nil;
    variance := nil;
    mean := nil;
    Freq := nil;
    selected := nil;
    subscript := nil;
    displace := nil;
    levels := nil;
    Maximum := nil;
    Minimum := nil;

    BreakDownFrm.Hide;
end;

procedure TBreakDownFrm.OutBtnClick(Sender: TObject);
var
   index1: integer;

begin
   index1 := ListBox1.ItemIndex;
   VarList.Items.Add(ListBox1.Items.Strings[index1]);
   ListBox1.Items.Delete(index1);
   InBtn.Visible := true;
   if ListBox1.Items.Count = 0 then OutBtn.Visible := false;
end;

function TBreakDownFrm.Index_Pos(var X1: IntDyneVec; var displace1: IntDyneVec;
  ListSize1: integer; Sender: TObject): integer;
var
   index1, i : integer;

begin
    index1 := X1[ListSize-1];
    for i := 1 to ListSize - 1 do
        index1 := index1 + ((X1[i-1] - 1) * displace[i-1]);
    Result := index1;
end;

initialization
  {$I breakdownunit.lrs}

end.