LazStats: Refactor KWAnovaUnit

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7824 8e941d3f-bd1b-0410-a28a-d453659cc2b4

applications/lazstats/source/forms/analysis/nonparametric/kwanovaunit.lfm

@@ -1,36 +1,36 @@
 inherited KWAnovaForm: TKWAnovaForm
   Left = 518
-  Height = 265
+  Height = 390
   Top = 283
-  Width = 565
+  Width = 748
   HelpType = htKeyword
   HelpKeyword = 'html/Kruskal-WallisOne-WayANOVA.htm'
   Caption = 'Kruskal-Wallis One Way ANOVA on Ranks'
-  ClientHeight = 265
+  ClientHeight = 390
-  ClientWidth = 565
+  ClientWidth = 748
   inherited ParamsPanel: TPanel
-    Height = 249
+    Height = 374
     Width = 363
-    ClientHeight = 249
+    ClientHeight = 374
     ClientWidth = 363
     inherited CloseBtn: TButton
       Left = 308
-      Top = 224
+      Top = 349
     end
     inherited ComputeBtn: TButton
       Left = 224
-      Top = 224
+      Top = 349
     end
     inherited ResetBtn: TButton
       Left = 162
-      Top = 224
+      Top = 349
     end
     inherited HelpBtn: TButton
       Left = 103
-      Top = 224
+      Top = 349
     end
     inherited ButtonBevel: TBevel
-      Top = 208
+      Top = 333
       Width = 363
     end
     object Label1: TLabel[5]
@@ -74,7 +74,7 @@ inherited KWAnovaForm: TKWAnovaForm
       AnchorSideRight.Control = GrpIn
       AnchorSideBottom.Control = OptionsGroup
       Left = 0
-      Height = 130
+      Height = 255
       Top = 17
       Width = 160
       Anchors = [akTop, akLeft, akRight, akBottom]
@@ -218,7 +218,7 @@ inherited KWAnovaForm: TKWAnovaForm
       AnchorSideBottom.Control = ButtonBevel
       Left = 0
       Height = 49
-      Top = 159
+      Top = 284
       Width = 180
       Anchors = [akLeft, akBottom]
       AutoSize = True
@@ -246,6 +246,26 @@ inherited KWAnovaForm: TKWAnovaForm
   end
   inherited ParamsSplitter: TSplitter
     Left = 375
-    Height = 265
+    Height = 390
+  end
+  object PageControl: TPageControl[2]
+    Left = 384
+    Height = 374
+    Top = 8
+    Width = 356
+    ActivePage = KWAnovaPage
+    Align = alClient
+    BorderSpacing.Left = 4
+    BorderSpacing.Top = 8
+    BorderSpacing.Right = 8
+    BorderSpacing.Bottom = 8
+    TabIndex = 0
+    TabOrder = 2
+    object KWAnovaPage: TTabSheet
+      Caption = 'Kruskal-Wallis One-Way ANOVA'
+    end
+    object MWUPage: TTabSheet
+      Caption = 'Mann-Whitney U Tests'
+    end
   end
 end

applications/lazstats/source/forms/analysis/nonparametric/kwanovaunit.pas

@@ -8,8 +8,8 @@ interface
 
 uses
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
-  StdCtrls, Buttons, ExtCtrls,
+  StdCtrls, Buttons, ExtCtrls, ComCtrls,
-  MainUnit, FunctionsLib, Globals, DataProcs, BasicStatsReportFormUnit;
+  MainUnit, FunctionsLib, Globals, ReportFrameUnit, BasicStatsReportFormUnit;
 
 type
 
@@ -29,6 +29,9 @@ type
     Label1: TLabel;
     Label2: TLabel;
     Label3: TLabel;
+    PageControl: TPageControl;
+    KWAnovaPage: TTabSheet;
+    MWUPage: TTabSheet;
     VarList: TListBox;
     procedure DepInClick(Sender: TObject);
     procedure DepOutClick(Sender: TObject);
@@ -37,7 +40,11 @@ type
     procedure VarListDblClick(Sender: TObject);
     procedure VarListSelectionChange(Sender: TObject; {%H-}User: boolean);
   private
+    MWUReportFrame: TReportFrame;
 	
+    procedure Process_MannWhitney(const ColNoSelected: IntDyneVec;
+      ANumGroups: Integer);
+
   protected
     procedure AdjustConstraints; override;
     procedure Compute; override;
@@ -45,7 +52,8 @@ type
     function Validate(out AMsg: String; out AControl: TWinControl): Boolean; override;
 
   public
-  procedure Reset; override;
+    constructor Create(AOwner: TComponent); override;
+    procedure Reset; override;
   end; 
 
 var
@@ -63,6 +71,28 @@ uses
 
 { 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;
@@ -78,20 +108,16 @@ end;
 procedure TKWAnovaForm.Compute;
 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;
+  NoTies, NoTieGroups, nogroups: integer;
-  largestN : integer;
   ColNoSelected : IntdyneVec = nil;
   group_count : IntDyneVec = nil;
   Ranks: DblDyneMat = nil;
   X : DblDyneMat = nil;
   RankSums: DblDyneVec = nil;
   score, t, SumT, Avg, Probchi, H, CorrectedH, value : double;
-  Correction, Temp, TieSum, alpha, U, U2, SD, z, prob : double;
+  Correction, TieSum: double;
-  cellstring, outline: string;
   lReport: TStrings;
 begin
-  alpha := StrToFloat(AlphaEdit.Text);
-
   // Allocate array memory
   SetLength(Ranks, NoCases, 2);
   SetLength(X, NoCases, 2);
@@ -99,7 +125,6 @@ begin
   // Get column numbers of the independent and dependent variables
   ind_var := GetVariableIndex(OS3MainFrm.DataGrid, GrpEdit.Text);
   dep_var := GetVariableIndex(OS3MainFrm.DataGrid, DepEdit.Text);
-  NoSelected := 2;
   SetLength(ColNoSelected, 2);
   ColNoSelected[0] := ind_var;
   ColNoSelected[1] := dep_var;
@@ -243,178 +268,14 @@ begin
     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', [k, ProbChi]);
 
-      if MWUChk.Checked then
+    FReportFrame.DisplayReport(lReport);
-      begin
-        lReport.Add('');
-        lReport.Add('------------------------------------------------------------------------');
-        lReport.Add('');
 
-        // Do Mann-Whitney U tests on group pairs
+    if MWUChk.Checked then
-        alpha := StrToFloat(AlphaEdit.Text);
+    begin
-        npairs := nogroups * (nogroups - 1) div 2;
+      MWUPage.TabVisible := true;
-        alpha := alpha / npairs;
+      Process_MannWhitney(ColNoSelected, NoGroups);
-        lReport.Add('New alpha for %d paired comparisons: %.3f', [npairs, alpha]);
+    end else
-        for i := 1 to nogroups - 1 do
+      MWUPage.TabVisible := false;
-        begin
-          for j := i + 1 to nogroups do
-          begin
-            // Setup for printer output
-            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;
-            total_n := 0;
-            for k := 1 to NoCases do
-            begin
-                if (not GoodRecord(OS3MainFrm.DataGrid, k, 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 := 0 to total_n-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
-            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
-                      Break;
-                    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;
-                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
-            lReport.Add('     Score     Rank      Group');
-            lReport.Add('');
-            for k := 1 to total_n 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', [NoTieGroups]);
-            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
-      end;
-
-    if lReport.Count > 0 then
-      FReportFrame.DisplayReport(lReport);
 
   finally
     lReport.Free;
@@ -472,19 +333,220 @@ begin
 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]);
+    VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i, 0]);
+
   UpdateBtnStates;
 end;