lazarus-ccr/applications/lazstats/source/forms/analysis/nonparametric/kwanovaunit.pas

// File for testing: "kwanova.laz"

unit KWANOVAUnit;

{$mode objfpc}{$H+}

interface

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

type

  { TKWAnovaForm }

  TKWAnovaForm = class(TBasicStatsReportForm)
    AlphaEdit: TEdit;
    OptionsGroup: TGroupBox;
    Label5: TLabel;
    MWUChk: TCheckBox;
    GrpEdit: TEdit;
    DepEdit: TEdit;
    GrpIn: TBitBtn;
    GrpOut: TBitBtn;
    DepIn: TBitBtn;
    DepOut: TBitBtn;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    PageControl: TPageControl;
    KWAnovaPage: TTabSheet;
    MWUPage: TTabSheet;
    VarList: TListBox;
    procedure DepInClick(Sender: TObject);
    procedure DepOutClick(Sender: TObject);
    procedure GrpInClick(Sender: TObject);
    procedure GrpOutClick(Sender: TObject);
    procedure VarListDblClick(Sender: TObject);
    procedure VarListSelectionChange(Sender: TObject; {%H-}User: boolean);
  private
    MWUReportFrame: TReportFrame;
	
    function Process_KruskalWallis(const ColNoSelected: IntDyneVec;
      ANumGroups, AMinGroup: Integer): Boolean;

    procedure Process_MannWhitney(const ColNoSelected: IntDyneVec;
      ANumGroups: Integer);

  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
  KWAnovaForm: TKWAnovaForm;


implementation

{$R *.lfm}

uses
  Math,
  Utils, GridProcs, MatrixUnit;


{ TKWAnovaForm }

constructor TKWAnovaForm.Create(AOwner: TComponent);
begin
  inherited;
  FReportFrame.Parent := KWAnovaPage;
  FReportFrame.BorderSpacing.Left := 0;
  FReportFrame.BorderSpacing.Top := 0;
  FReportFrame.BorderSpacing.Bottom := 0;
  FReportFrame.BorderSpacing.Right := 0;

  MWUReportFrame := TReportFrame.Create(self);
  MWUReportFrame.Name := '';
  MWUReportFrame.Parent := MWUPage;
  MWUReportFrame.Align := alClient;
  MWUReportFrame.BorderSpacing.Left := 0;
  MWUReportFrame.BorderSpacing.Top := 0;
  MWUReportFrame.BorderSpacing.Bottom := 0;
  MWUReportFrame.BorderSpacing.Right := 0;
  InitToolbar(MWUReportFrame.ReportToolbar, tpRight);

  PageControl.ActivePageIndex := 0;
end;

procedure TKWAnovaForm.AdjustConstraints;
begin
  inherited;
  ParamsPanel.Constraints.MinWidth := Max(
    4*CloseBtn.Width + 3*CloseBtn.BorderSpacing.Left,
    2*OptionsGroup.Width);
  ParamsPanel.Constraints.MinHeight := DepOut.Top + DepOut.Height +
    VarList.BorderSpacing.Bottom + OptionsGroup.Height +
    ButtonBevel.Height + CloseBtn.BorderSpacing.Top + CloseBtn.Height;
end;


procedure TKWAnovaForm.Compute;
var
  i, ind_var, dep_var, min_grp, max_grp, group, total_n : integer;
  nogroups: integer;
  ColNoSelected : IntdyneVec = nil;
begin
  // Get column numbers of the independent and dependent variables
  ind_var := GetVariableIndex(OS3MainFrm.DataGrid, GrpEdit.Text);
  dep_var := GetVariableIndex(OS3MainFrm.DataGrid, DepEdit.Text);
  SetLength(ColNoSelected, 2);
  ColNoSelected[0] := ind_var;
  ColNoSelected[1] := dep_var;

  // Get minimum and maximum group codes
  total_n := 0;
  min_grp := MaxInt;
  max_grp := -MaxInt;
  for i := 1 to NoCases do
  begin
    if (not GoodRecord(OS3MainFrm.DataGrid, i, 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;

  // Execute Kruskal-Wallis ANOVA
  if not Process_KruskalWallis(ColNoSelected, noGroups, min_grp) then
    exit;

  // Excute Mann-Whitney U Tests
  if MWUChk.Checked then
  begin
    MWUPage.TabVisible := true;
    Process_MannWhitney(ColNoSelected, NoGroups);
  end else
    MWUPage.TabVisible := false;
end;


procedure TKWAnovaForm.DepInClick(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 TKWAnovaForm.DepOutClick(Sender: TObject);
begin
  if DepEdit.Text <> '' then
  begin
    VarList.Items.Add(DepEdit.Text);
    DepEdit.Text := '';
  end;
  UpdateBtnStates;
end;


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


procedure TKWAnovaForm.GrpOutClick(Sender: TObject);
begin
  if GrpEdit.Text <> '' then
  begin
    VarList.Items.Add(GrpEdit.Text);
    GrpEdit.Text := '';
  end;
  UpdateBtnStates;
end;


// Do Kruskal-Wallis One-Way ANOVA
function TKWAnovaForm.Process_KruskalWallis(const ColNoSelected: IntDyneVec;
  ANumGroups, AMinGroup: Integer): Boolean;
var
  i, j: Integer;
  group, totalN, numTieGroups, numTies, depVar, indVar: Integer;
  score, T, sumT, tieSum, avg, H, correction, correctedH, probChi: Double;
  rankSums: DblDyneVec = nil;
  groupCount: IntDyneVec = nil;
  X: DblDyneMat = nil;
  Ranks: DblDyneMat = nil;
  lReport: TStrings;
begin
  Result := false;

  // Initialize arrays
  SetLength(Ranks, NoCases, 2);
  SetLength(X, NoCases, 2);
  SetLength(RankSums, ANumGroups);
  SetLength(groupCount, ANumGroups);
  for i := 0 to ANumGroups-1 do
  begin
    groupCount[i] := 0;
    rankSums[i] := 0.0;
  end;

  depVar := ColNoSelected[1];
  indVar := ColNoSelected[0];

  // Get data
  totalN := 0;
  for i := 1 to NoCases do
  begin
    if (not GoodRecord(OS3MainFrm.DataGrid, i, ColNoSelected)) then continue;
    score := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[depVar, i]));
    group := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[indVar, i])));
    group := group - AMinGroup + 1;
    if (group > ANumGroups) then
    begin
      ErrorMsg('Group codes must be sequential like 1 and 2!');
      exit;
    end;
    inc(groupCount[group-1]);
    X[i-1, 0] := score;
    X[i-1, 1] := group;
    inc(totalN);
  end;

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

  // Store ranks
  for i := 0 to totalN - 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
  sumT := 0.0;
  numTieGroups := 0;
  i := 1;
  while i < totalN do
  begin
    j := i + 1;
    tieSum := 0;
    numTies := 0;
    while (j < totalN) do
    begin
      if (X[j-1, 0] > X[i-1, 0]) then
        break;
      if (X[j-1, 0] = X[i-1, 0]) then // match
      begin
        tieSum := tieSum + round(Ranks[j-1,0]);
        inc(numTies);
      end;
      inc(j);
    end;

    if (numTies > 0) then // At least one tie found
    begin
      tieSum := tieSum + Ranks[i-1,0];
      numTies := numTies + 1;
      avg := tieSum / numTies;
      for j := i to i + numTies - 1 do
        Ranks[j-1,0] := avg;
      t := numTies * numTies * numTies - numTies;
      sumT := sumT + t;
      inc(numTieGroups);
      i := i + (numTies - 1);
    end;
    inc(i);
  end; // next i

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

  // Calculate statistics
  H := 0.0;
  for j := 0 to ANumGroups-1 do
    H := H + (rankSums[j] * RankSums[j] / (groupCount[j]));
  H := H * (12.0 / ( totalN * (totalN + 1)) );
  H := H - (3.0 * (totalN + 1));
  correction := 1.0 - ( sumT / (totalN * totalN * totalN - totalN) );
  correctedH := H / correction;
  probChi := 1.0 - ChiSquaredProb(H, ANumGroups-1);

  // Report results
  lReport := TStringList.Create;
  try
    lReport.Add('KRUSKAL-WALLIS ONE-WAY ANALYSIS OF VARIANCE');
    lReport.Add('See pages 184-194 in S. Siegel: Nonparametric Statistics for the Behavioral Sciences');
    lReport.Add('');

    lReport.Add('     Score     Rank      Group');
    lReport.Add('');
    for i := 0 to totalN-1 do
      lReport.Add('%10.2f %10.2f %10.0f', [X[i,0], Ranks[i,0], Ranks[i,1]]);
    lReport.Add('');
    lReport.Add('Sum of Ranks in each Group');
    lReport.Add('Group   Sum    No. in Group');
    for i := 0 to ANumGroups-1 do
      lReport.Add('%3d  %10.2f %5d', [i+AMinGroup, RankSums[i], groupCount[i]]);
    lReport.Add('');
    lReport.Add('No. of tied rank groups           %8d',   [numTieGroups]);
    lReport.Add('Statistic H uncorrected for ties: %8.4f', [H]);
    lReport.Add('Correction for Ties:              %8.4f', [Correction]);
    lReport.Add('Statistic H corrected for ties:   %8.4f', [CorrectedH]);
    lReport.Add('Corrected H is approx. chi-square with %d degrees of freedom and probability %.4f', [ANumGroups-1, ProbChi]);

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

  Result := true;
end;

// Do Mann-Whitney U tests on group pairs
procedure TKWAnovaForm.Process_MannWhitney(const ColNoSelected: IntDyneVec;
  ANumGroups: Integer);
var
  alpha, score, value, tieSum, avg, T, sumT, U, U2, SD, z, prob: Double;
  nPairs: Integer;
  i, j, k, m: Integer;
  totalN, depVar, IndVar, numTies, numTieGroups, group, n1, n2, largestN: Integer;
  outline: String;
  lReport: TStrings;
  group_count: IntDyneVec = nil;
  RankSums: DblDyneVec = nil;
  X: DblDyneMat = nil;
  Ranks: DblDyneMat = nil;
begin
  SetLength(X, NoCases, 2);
  SetLength(Ranks, NoCases, 2);
  SetLength(group_count, 2);
  SetLength(RankSums, ANumGroups);

  numTieGroups := 0;
  sumT := 0.0;

  alpha := StrToFloat(AlphaEdit.Text);
  nPairs := ANumGroups * (ANumGroups - 1) div 2;
  alpha := alpha / nPairs;

  indVar := ColNoSelected[0];
  depVar := ColNoSelected[1];

  lReport := TStringList.Create;
  try
    lReport.Add('New alpha for %d paired comparisons: %.3f', [nPairs, alpha]);
    for i := 1 to ANumGroups - 1 do
    begin
      for j := i + 1 to ANumGroups do
      begin
        lReport.Add('');
        lReport.Add('');
        lReport.Add('MANN-WHITNEY U TEST');
        lReport.Add('See pages 116-127 in S. Siegel: Nonparametric Statistics for the Behavioral Sciences');
        lReport.Add('');
        lReport.Add('Comparison of group %d with group %d', [i, j]);

        group_count[0] := 0;
        group_count[1] := 0;
        RankSums[0] := 0;
        RankSums[1] := 0;
        totalN := 0;
        for k := 1 to NoCases do
        begin
          if (not GoodRecord(OS3MainFrm.DataGrid, k, ColNoSelected)) then continue;
          score := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[depVar, k]));
          value := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[indVar, k]));
          if round(value) = i then
          begin
            X[totalN, 0] := score;
            X[totalN, 1] := value;
            inc(group_count[0]);
            inc(totalN);
          end;
          if round(value) = j then
          begin
            X[totalN, 0] := score;
            X[totalN, 1] := value;
            inc(group_count[1]);
            inc(totalN);
          end;
        end; // next case k

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

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

        // Check for ties in ranks - replace with average rank and calculate
        // T for each tie and sum of the T's
        numTieGroups := 0;
        k := 1;
        while k < totalN do
        begin
          m := k + 1;
          tieSum := 0;
          numTies := 0;
          while (m < totalN) do
          begin
            if (X[m-1, 0] > X[k-1, 0]) then
              Break;
            if (X[m-1, 0] = X[k-1, 0]) then // match
            begin
              tieSum := tieSum + round(Ranks[m-1, 0]);
              inc(numTies);
            end;
            inc(m);
          end;
          if (numTies > 0) then //At least one tie found
          begin
            tieSum := tieSum + Ranks[k-1, 0];
            inc(numTies);
            avg := tieSum / numTies;
            for m := k to k + numTies - 1 do
              Ranks[m-1,0] := avg;
            T := numTies * numTies * numTies - numTies;
            sumT := sumT + T;
            inc(numTieGroups);
            k := k + (numTies - 1);
          end;
          inc(k);
        end; // next k

        // Calculate sum of ranks in each group
        for k := 0 to totalN-1 do
        begin
          group := round(Ranks[k, 1]);
          RankSums[group-1] := RankSums[group-1] + Ranks[k, 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
        lReport.Add('     Score     Rank      Group');
        lReport.Add('');
        for k := 1 to totalN do
          lReport.Add('%10.2f %10.2f %10.0f', [X[k-1,0], Ranks[k-1,0], Ranks[k-1,1]]);
        lReport.Add('');
        lReport.Add('Sum of Ranks in each Group');
        lReport.Add('Group   Sum    No. in Group');
        group := i - 1;
        lReport.Add('%3d  %10.3f %5d', [i, RankSums[group], group_count[0]]);
        group := j - 1;
        lReport.Add('%3d  %10.3f %5d', [j, RankSums[group], group_count[1]]);
        lReport.Add('');
        lReport.Add(            'No. of tied rank groups:          %8d', [numTieGroups]);
        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;
        lReport.Add(outline);
        lReport.Add(            'z Statistic (corrected for ties): %8.4f', [z]);
        lReport.Add(            'Prob. > z:                        %8.4f', [prob]);
        if (n2 < 20) then
        begin
          lReport.Add('z test is approximate.  Use tables of exact probabilities in Siegel.');
          lReport.Add('(Table J or K, pages 271-277)');
        end;
      end; // next group j
    end; // next group i

    MWUReportFrame.DisplayReport(lReport);

  finally
    lReport.Free;
  end;
end;

procedure TKWAnovaForm.Reset;
var
  i: integer;
begin
  inherited;

  MWUPage.TabVisible := false;

  GrpEdit.Clear;
  DepEdit.Clear;
  AlphaEdit.Text := FormatFloat('0.00', DEFAULT_ALPHA_LEVEL);
  MWUChk.Checked := false;
  VarList.Items.Clear;
  for i := 1 to NoVariables do
    VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i, 0]);

  UpdateBtnStates;
end;


procedure TKWAnovaForm.UpdateBtnStates;
begin
  inherited;
  GrpIn.Enabled := (VarList.Items.Count > 0) and (GrpEdit.Text = '');
  DepIn.Enabled := (VarList.Items.Count > 0) and (DepEdit.Text = '');
  GrpOut.Enabled := (GrpEdit.Text <> '');
  DepOut.Enabled := (DepEdit.Text <> '');
end;


function TKWAnovaForm.Validate(out AMsg: String; out AControl: TWinControl): Boolean;
var
  x: Double;
begin
  Result := false;

  if (NoVariables < 1) then
  begin
    AMsg := 'You must have grid data!';
    AControl := VarList;
    exit;
  end;

  if GrpEdit.Text = '' then
  begin
    AMsg := 'Group variable not specified.';
    AControl := GrpEdit;
    exit;
  end;

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

  if AlphaEdit.Text = '' then
  begin
    AMsg := 'Alpha level not specified.';
    AControl := AlphaEdit;
    exit;
  end;
  if not TryStrToFloat(AlphaEdit.Text, x) or (x <= 0) or (x >= 1) then
  begin
    AMsg := 'Alpha level must be a valid number between 0 and 1.';
    AControl := AlphaEdit;
    exit;
  end;

  Result := true;
end;


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


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


end.