unit KWANOVAUnit;

{$mode objfpc}{$H+}

interface

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

type

  { TKWAnovaFrm }

  TKWAnovaFrm = class(TForm)
    AlphaEdit: TEdit;
    Label4: TLabel;
    Label5: TLabel;
    MWUChk: TCheckBox;
    ResetBtn: TButton;
    CancelBtn: TButton;
    ComputeBtn: TButton;
    ReturnBtn: TButton;
    GrpEdit: TEdit;
    DepEdit: TEdit;
    GrpIn: TBitBtn;
    GrpOut: TBitBtn;
    DepIn: TBitBtn;
    DepOut: TBitBtn;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    VarList: TListBox;
    procedure ComputeBtnClick(Sender: TObject);
    procedure DepInClick(Sender: TObject);
    procedure DepOutClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure GrpInClick(Sender: TObject);
    procedure GrpOutClick(Sender: TObject);
    procedure ResetBtnClick(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end; 

var
  KWAnovaFrm: TKWAnovaFrm;

implementation

{ TKWAnovaFrm }

procedure TKWAnovaFrm.ResetBtnClick(Sender: TObject);
VAR i : integer;
begin
     GrpEdit.Text := '';
     DepEdit.Text := '';
     AlphaEdit.Text := '0.05';
     GrpIn.Visible := true;
     GrpOut.Visible := false;
     DepIn.Visible := true;
     DepOut.Visible := false;
     MWUChk.Checked := false;
     VarList.Items.Clear;
     for i := 1 to NoVariables do
         VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
end;

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

procedure TKWAnovaFrm.DepInClick(Sender: TObject);
VAR index : integer;
begin
     index := VarList.ItemIndex;
     DepEdit.Text := VarList.Items.Strings[index];
     VarList.Items.Delete(index);
     DepIn.Visible := false;
     DepOut.Visible := true;
end;

procedure TKWAnovaFrm.ComputeBtnClick(Sender: TObject);
label cleanup, Check1, Check2;
var
    i, j, k, m, ind_var, dep_var, min_grp, max_grp, group, total_n : integer;
    NoTies, NoTieGroups, nogroups, NoSelected, npairs, n1, n2 : integer;
    largestn : integer;
    ColNoSelected : IntdyneVec;
    group_count : IntDyneVec;
    score, t, SumT, Avg, Probchi, H, CorrectedH, value : double;
    Correction, Temp, TieSum, alpha, U, U2, SD, z, prob : double;
    Ranks, X : DblDyneMat;
    RankSums : DblDyneVec;
    cellstring, outline : string;
begin
    // Check for data
    if (NoVariables < 1) then
    begin
        ShowMessage('ERROR! You must have grid data!');
        exit;
    end;

    // allocate space
    SetLength(ColNoSelected,NoVariables);
    SetLength(Ranks,NoCases,2);
    SetLength(X,NoCases,2);

    // Get column numbers of the independent and dependent variables
    ind_var := 0;
    dep_var := 0;
    for i := 1 to NoVariables do
    begin
        cellstring := GrpEdit.Text;
        if (cellstring = OS3MainFrm.DataGrid.Cells[i,0]) then ind_var := i;
        cellstring := DepEdit.Text;
        if (cellstring = OS3MainFrm.DataGrid.Cells[i,0]) then dep_var := i;
    end;
    ColNoSelected[0] := ind_var;
    ColNoSelected[1] := dep_var;

    //get minimum and maximum group codes
    total_n := 0;
    NoSelected := 2;
    min_grp := 10000; //atoi(MainForm.Grid.Cells[ind_var,1].c_str);
    max_grp := -10000;
    for i := 1 to NoCases do
    begin
        if (not GoodRecord(i,NoSelected,ColNoSelected)) then continue;
        group := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[ind_var,i])));
        if (group < min_grp) then min_grp := group;
        if (group > max_grp) then max_grp := group;
        total_n := total_n + 1;
    end;
    nogroups := max_grp - min_grp + 1;
    NoTieGroups := 0;
    SumT := 0.0;
    H := 0.0;

    // Initialize arrays
    SetLength(RankSums,nogroups);
    SetLength(group_count,nogroups);
    for i := 0 to nogroups-1 do
    begin
        group_count[i] := 0;
        RankSums[i] := 0.0;
    end;

    // Setup for printer output
    OutPutFrm.RichEdit.Clear;
    OutPutFrm.RichEdit.Lines.Add('Kruskal - Wallis One-Way Analysis of Variance');
    OutPutFrm.RichEdit.Lines.Add('See pages 184-194 in S. Siegel: Nonparametric Statistics for the Behavioral Sciences');
    OutPutFrm.RichEdit.Lines.Add('');

    // Get data
    for i := 1 to NoCases do
    begin
        if (not GoodRecord(i,NoSelected,ColNoSelected)) then continue;
        score := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[dep_var,i]));
        group := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[ind_var,i])));
        group := group - min_grp + 1;
        if (group > nogroups) then
        begin
            ShowMessage('ERROR! Group codes must be sequential like 1 and 2!');
            goto cleanup;
        end;
        group_count[group-1] := group_count[group-1] + 1;
        X[i-1,0] := score;
        X[i-1,1] := group;
    end;

    //Sort all scores in ascending order
    for i := 1 to total_n - 1 do
    begin
        for j := i + 1 to total_n do
        begin
            if (X[i-1,0] > X[j-1,0]) then
            begin
                Temp := X[i-1,0];
                X[i-1,0] := X[j-1,0];
                X[j-1,0] := Temp;
                Temp := X[i-1,1];
                X[i-1,1] := X[j-1,1];
                X[j-1,1] := Temp;
            end;
        end;
    end;

    // Store ranks
    for i := 0 to total_n-1 do
    begin
        Ranks[i,0] := i+1;
        Ranks[i,1] := X[i,1];
    end;

    //Check for ties in ranks - replace with average rank and calculate
    //T for each tie and sum of the T's
    i := 1;
    while i < total_n do
    begin
        j := i + 1;
        TieSum := 0;
        NoTies := 0;
        while (j < total_n) do
        begin
            if (X[j-1,0] > X[i-1,0]) then goto Check1;
            if (X[j-1,0] = X[i-1,0]) then // match
            begin
                TieSum := TieSum + round(Ranks[j-1,0]);
                NoTies := NoTies + 1;
            end;
            j := j + 1;
        end;
Check1:
        if (NoTies > 0) then //At least one tie found
        begin
            TieSum := TieSum + Ranks[i-1,0];
            NoTies := NoTies + 1;
            Avg := TieSum / NoTies;
            for j := i to i + NoTies - 1 do Ranks[j-1,0] := Avg;
            t := Power(NoTies,3) - NoTies;
            SumT := SumT + t;
            NoTieGroups := NoTieGroups + 1;
            i := i + (NoTies - 1);
        end;
        i := i + 1;
    end; // next i

    // Calculate sum of ranks in each group
    for i := 1 to total_n do
    begin
        group := round(Ranks[i-1,1]);
        RankSums[group-1] := RankSums[group-1] + Ranks[i-1,0];
    end;

    // Calculate statistics
    for j := 0 to nogroups-1 do H := H + (RankSums[j] * RankSums[j] / (group_count[j]));
    H := H * (12.0 / ( total_n * (total_n + 1)) );
    H := H - (3.0 * (total_n + 1));
    Correction := 1.0 - ( SumT / (Power(total_n,3) - total_n) );
    CorrectedH := H / Correction;
    k := max_grp - min_grp;
    Probchi := 1.0 - chisquaredprob(H, k);

    // Report results
    OutPutFrm.RichEdit.Lines.Add('     Score     Rank      Group');
    OutPutFrm.RichEdit.Lines.Add('');
    for i := 1 to total_n do
    begin
        outline := format('%10.2f %10.2f %10.0f',
            [X[i-1,0], Ranks[i-1,0], Ranks[i-1,1]]);
        OutPutFrm.RichEdit.Lines.Add(outline);
    end;
    OutPutFrm.RichEdit.Lines.Add('');
    OutPutFrm.RichEdit.Lines.Add('Sum of Ranks in each Group');
    OutPutFrm.RichEdit.Lines.Add('Group   Sum    No. in Group');
    for i := 1 to nogroups do
    begin
        outline := format('%3d  %10.2f %5d', [i+min_grp-1, RankSums[i-1],group_count[i-1]]);
        OutPutFrm.RichEdit.Lines.Add(outline);
    end;
    OutPutFrm.RichEdit.Lines.Add('');
    outline := format('No. of tied rank groups = %3d',[NoTieGroups]);
    OutPutFrm.RichEdit.Lines.Add(outline);
    outline := format('Statistic H uncorrected for ties = %8.4f',[H]);
    OutPutFrm.RichEdit.Lines.Add(outline);
    outline := format('Correction for Ties = %6.4f',[Correction]);
    OutPutFrm.RichEdit.Lines.Add(outline);
    outline := format('Statistic H corrected for ties = %8.4f',[CorrectedH]);
    OutPutFrm.RichEdit.Lines.Add(outline);
    outline := format('Corrected H is approx. chi-square with %3d D.F. and probability = %6.4f',[k,Probchi]);
    OutPutFrm.RichEdit.Lines.Add(outline);
    OutPutFrm.ShowModal;
    OutPutFrm.RichEdit.Clear;

    if not MWUChk.Checked then goto cleanup;
    // do Mann-Whitney U tests on group pairs
    alpha := StrToFloat(AlphaEdit.Text);
    npairs := nogroups * (nogroups - 1) div 2;
    alpha := alpha / npairs;
    outline := format('New alpha for %d paired comparisons = %5.3f',[npairs, alpha]);
    ShowMessage(outline);
    for i := 1 to nogroups - 1 do
    begin
        for j := i + 1 to nogroups do
        begin
            // Setup for printer output
            OutPutFrm.RichEdit.Clear;
            OutPutFrm.RichEdit.Lines.Add('Mann-Whitney U Test');
            OutPutFrm.RichEdit.Lines.Add('See pages 116-127 in S. Siegel: Nonparametric Statistics for the Behavioral Sciences');
            OutPutFrm.RichEdit.Lines.Add('');
            outline := format('Comparison of group %d with group %d',[i,j]);
            OutPutFrm.RichEdit.Lines.Add(outline);
            group_count[0] := 0;
            group_count[1] := 0;
            RankSums[0] := 0;
            RankSums[1] := 0;
            total_n := 0;
            for k := 1 to NoCases do
            begin
                if (not GoodRecord(k,NoSelected,ColNoSelected)) then continue;
                score := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[dep_var,k]));
                value := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[ind_var,k]));
                if round(value) = i then
                begin
                     X[total_n,0] := score;
                     X[total_n,1] := value;
                     group_count[0] := group_count[0] + 1;
                     total_n := total_n + 1;
                end;
                if round(value) = j then
                begin
                     X[total_n,0] := score;
                     X[total_n,1] := value;
                     group_count[1] := group_count[1] + 1;
                     total_n := total_n + 1;
                end;
            end; // next case k

            //Sort all scores in ascending order
            for k := 1 to total_n - 1 do
            begin
                for m := k + 1 to total_n do
                begin
                    if (X[k-1,0] > X[m-1,0]) then
                    begin
                        Temp := X[k-1,0];
                        X[k-1,0] := X[m-1,0];
                        X[m-1,0] := Temp;
                        Temp := X[k-1,1];
                        X[k-1,1] := X[m-1,1];
                        X[m-1,1] := Temp;
                    end;
                end;
            end;

            // get ranks for these two groups
            for k := 1 to total_n do
            begin
                Ranks[k-1,0] := k;
                Ranks[k-1,1] := X[k-1,1];
            end;

            //Check for ties in ranks - replace with average rank and calculate
            //T for each tie and sum of the T's
            NoTieGroups := 0;
            k := 1;
            while k < total_n do
            begin
                m := k + 1;
                TieSum := 0;
                NoTies := 0;
                while (m < total_n) do
                begin
                    if (X[m-1,0] > X[k-1,0]) then goto Check2;
                    if (X[m-1,0] = X[k-1,0]) then // match
                    begin
                        TieSum := TieSum + round(Ranks[m-1,0]);
                        NoTies := NoTies + 1;
                    end;
                    m := m + 1;
                end;
        Check2:
                if (NoTies > 0) then //At least one tie found
                begin
                    TieSum := TieSum + Ranks[k-1,0];
                    NoTies := NoTies + 1;
                    Avg := TieSum / NoTies;
                    for m := k to k + NoTies - 1 do Ranks[m-1,0] := Avg;
                    t := Power(NoTies,3) - NoTies;
                    SumT := SumT + t;
                    NoTieGroups := NoTieGroups + 1;
                    k := k + (NoTies - 1);
                end;
                k := k + 1;
            end; // next k

            // Calculate sum of ranks in each group
            for k := 1 to total_n do
            begin
                group := round(Ranks[k-1,1]);
                RankSums[group-1] := RankSums[group-1] + Ranks[k-1,0];
            end;

            //Calculate U for larger and smaller groups
            n1 := group_count[0];
            n2 := group_count[1];
            if (n1 > n2) then
            begin
                group := i-1;
                U := (n1 * n2) + ((n1 * (n1 + 1)) / 2.0) - RankSums[group];
            end
            else
            begin
                group := j - 1;
                U := (n1 * n2) + ((n2 * (n2 + 1)) / 2.0) - RankSums[group];
            end;
            U2 := (n1 * n2) - U;
            SD := (n1 * n2 * (n1 + n2 + 1)) / 12.0;
            SD := sqrt(SD);
            if (U2 > U) then z := (U2 - (n1 * n2 / 2)) / SD
            else z := (U - (n1 * n2 / 2)) / SD;
            prob := 1.0 - probz(z);

            //Report results
            OutPutFrm.RichEdit.Lines.Add('     Score     Rank      Group');
            OutPutFrm.RichEdit.Lines.Add('');
            for k := 1 to total_n do
            begin
                outline := format('%10.2f %10.2f %10.0f',
                    [X[k-1,0], Ranks[k-1,0], Ranks[k-1,1]]);
                OutPutFrm.RichEdit.Lines.Add(outline);
            end;
            OutPutFrm.RichEdit.Lines.Add('');
            OutPutFrm.RichEdit.Lines.Add('Sum of Ranks in each Group');
            OutPutFrm.RichEdit.Lines.Add('Group   Sum    No. in Group');
            group := i - 1;
            outline := format('%3d  %10.3f %5d', [i, RankSums[group],group_count[0]]);
            OutPutFrm.RichEdit.Lines.Add(outline);
            group := j - 1;
            outline := format('%3d  %10.3f %5d', [j, RankSums[group],group_count[1]]);
            OutPutFrm.RichEdit.Lines.Add(outline);
            OutPutFrm.RichEdit.Lines.Add('');
            outline := format('No. of tied rank groups = %3d',[NoTieGroups]);
            OutPutFrm.RichEdit.Lines.Add(outline);
            if (n1 > n2) then largestn := n1
            else largestn := n2;
            if (largestn < 20) then
                outline := format('Statistic U = %8.4f',[U])
            else
            begin
                if (U > U2) then outline := format('Statistic U = %8.4f',[U])
                else outline := format('Statistic U = %8.4f',[U2]);
            end;
            OutPutFrm.RichEdit.Lines.Add(outline);
            outline := format('z Statistic (corrected for ties) = %8.4f, Prob. > z = %6.4f',
                             [z, prob]);
            OutPutFrm.RichEdit.Lines.Add(outline);
            if (n2 < 20) then
            begin
                OutPutFrm.RichEdit.Lines.Add('z test is approximate.  Use tables of exact probabilities in Siegel.');
                OutPutFrm.RichEdit.Lines.Add('(Table J or K, pages 271-277)');
            end;
            OutPutFrm.ShowModal;
        end; // next group j
    end; // next group i
cleanup:
    group_count := nil;
    RankSums := nil;
    X := nil;
    Ranks := nil;
    ColNoSelected := nil;
end;

procedure TKWAnovaFrm.DepOutClick(Sender: TObject);
begin
     VarList.Items.Add(DepEdit.Text);
     DepEdit.Text := '';
     DepIn.Visible := true;
     DepOut.Visible := false;
end;

procedure TKWAnovaFrm.GrpInClick(Sender: TObject);
VAR index : integer;
begin
     index := VarList.ItemIndex;
     GrpEdit.Text := VarList.Items.Strings[index];
     VarList.Items.Delete(index);
     GrpIn.Visible := false;
     GrpOut.Visible := true;
end;

procedure TKWAnovaFrm.GrpOutClick(Sender: TObject);
begin
     VarList.Items.Add(GrpEdit.Text);
     GrpEdit.Text := '';
     GrpIn.Visible := true;
     GrpOut.Visible := false;
end;

initialization
  {$I kwanovaunit.lrs}

end.