From 3f1dd4c7cbacb0ead382adc774d64074573a9064 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Wed, 28 Oct 2020 23:39:08 +0000 Subject: [PATCH] LazStats: Refactor KWAnovaUnit git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7824 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../analysis/nonparametric/kwanovaunit.lfm | 48 +- .../analysis/nonparametric/kwanovaunit.pas | 426 ++++++++++-------- 2 files changed, 278 insertions(+), 196 deletions(-) diff --git a/applications/lazstats/source/forms/analysis/nonparametric/kwanovaunit.lfm b/applications/lazstats/source/forms/analysis/nonparametric/kwanovaunit.lfm index 24004756e..2bc3895c7 100644 --- a/applications/lazstats/source/forms/analysis/nonparametric/kwanovaunit.lfm +++ b/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 - ClientWidth = 565 + ClientHeight = 390 + 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 diff --git a/applications/lazstats/source/forms/analysis/nonparametric/kwanovaunit.pas b/applications/lazstats/source/forms/analysis/nonparametric/kwanovaunit.pas index 0d52e03d4..7caca24c7 100644 --- a/applications/lazstats/source/forms/analysis/nonparametric/kwanovaunit.pas +++ b/applications/lazstats/source/forms/analysis/nonparametric/kwanovaunit.pas @@ -8,8 +8,8 @@ interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, - StdCtrls, Buttons, ExtCtrls, - MainUnit, FunctionsLib, Globals, DataProcs, BasicStatsReportFormUnit; + StdCtrls, Buttons, ExtCtrls, ComCtrls, + 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; - largestN : integer; + NoTies, NoTieGroups, nogroups: 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; - cellstring, outline: string; + Correction, TieSum: double; 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 - begin - lReport.Add(''); - lReport.Add('------------------------------------------------------------------------'); - lReport.Add(''); + FReportFrame.DisplayReport(lReport); - // Do Mann-Whitney U tests on group pairs - alpha := StrToFloat(AlphaEdit.Text); - npairs := nogroups * (nogroups - 1) div 2; - alpha := alpha / npairs; - lReport.Add('New alpha for %d paired comparisons: %.3f', [npairs, alpha]); - for i := 1 to nogroups - 1 do - 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); + if MWUChk.Checked then + begin + MWUPage.TabVisible := true; + Process_MannWhitney(ColNoSelected, NoGroups); + end else + MWUPage.TabVisible := false; 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;