You've already forked lazarus-ccr
cfe3a9c460
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7814 8e941d3f-bd1b-0410-a28a-d453659cc2b4
378 lines
8.8 KiB
ObjectPascal
378 lines
8.8 KiB
ObjectPascal
// File for testing: manwhitU.laz
|
|
|
|
unit MannWhitUUnit;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
|
|
StdCtrls, Buttons, ExtCtrls,
|
|
MainUnit, FunctionslIB, Globals, BasicStatsReportFormUnit;
|
|
|
|
type
|
|
|
|
{ TMannWhitUForm }
|
|
|
|
TMannWhitUForm = class(TBasicStatsReportForm)
|
|
Bevel3: TBevel;
|
|
GrpIn: TBitBtn;
|
|
GrpOut: TBitBtn;
|
|
DepIn: TBitBtn;
|
|
DepOut: TBitBtn;
|
|
GrpEdit: TEdit;
|
|
DepEdit: TEdit;
|
|
Label1: TLabel;
|
|
Label2: TLabel;
|
|
Label3: TLabel;
|
|
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
|
|
|
|
protected
|
|
procedure AdjustConstraints; override;
|
|
procedure Compute; override;
|
|
procedure UpdateBtnStates; override;
|
|
|
|
public
|
|
procedure Reset; override;
|
|
end;
|
|
|
|
var
|
|
MannWhitUForm: TMannWhitUForm;
|
|
|
|
implementation
|
|
|
|
{$R *.lfm}
|
|
|
|
uses
|
|
Math,
|
|
Utils, MatrixUnit, GridProcs;
|
|
|
|
{ TMannWhitUForm }
|
|
|
|
procedure TMannWhitUForm.AdjustConstraints;
|
|
begin
|
|
inherited;
|
|
|
|
ParamsPanel.Constraints.MinWidth := 4*CloseBtn.Width + 3*CloseBtn.BorderSpacing.Left;
|
|
ParamsPanel.Constraints.MinHeight := DepOut.Top + DepOut.Height +
|
|
ButtonBevel.Height + CloseBtn.BorderSpacing.Top + CloseBtn.Height;
|
|
end;
|
|
|
|
|
|
procedure TMannWhitUForm.Compute;
|
|
var
|
|
ColNoSelected: IntDyneVec = nil;
|
|
group_count: IntdyneVec = nil;
|
|
Ranks: DblDyneMat = nil;
|
|
X: DblDyneMat = nil;
|
|
RankSums: DblDyneVec = nil;
|
|
i, j, ind_var, dep_var, min_grp, max_grp, group, total_n: integer;
|
|
NoTies, NoTieGroups, n1, n2, nogroups, largestn: integer;
|
|
TieSum, score, t, SumT, Avg, z, prob, U, U2, SD: double;
|
|
outline: string;
|
|
lReport: TStrings;
|
|
|
|
begin
|
|
total_n := 0;
|
|
NoTieGroups := 0;
|
|
SumT := 0.0;
|
|
|
|
// Check for data
|
|
if (NoVariables < 1) then
|
|
begin
|
|
ErrorMsg('You must have grid data!');
|
|
exit;
|
|
end;
|
|
|
|
// Get column numbers of the independent and dependent variables
|
|
ind_var := GetVariableIndex(OS3MainFrm.DataGrid, GrpEdit.Text);
|
|
dep_var := GetVariableIndex(OS3MainFrm.DataGrid, DepEdit.Text);
|
|
if ind_var = -1 then
|
|
begin
|
|
ErrorMsg('No group variable.');
|
|
exit;
|
|
end;
|
|
if dep_var = -1 then
|
|
begin
|
|
ErrorMsg('No dependent variable.');
|
|
exit;
|
|
end;
|
|
|
|
SetLength(ColNoSelected, 2);
|
|
ColNoSelected[0] := ind_var;
|
|
ColNoSelected[1] := dep_var;
|
|
|
|
//get minimum and maximum group codes
|
|
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;
|
|
|
|
// Initialize arrays
|
|
SetLength(RankSums,nogroups);
|
|
SetLength(Ranks,NoCases,2);
|
|
SetLength(X,NoCases,2);
|
|
SetLength(group_count,nogroups);
|
|
for i := 0 to nogroups-1 do
|
|
begin
|
|
group_count[i] := 0;
|
|
RankSums[i] := 0.0;
|
|
end;
|
|
|
|
// Get data
|
|
for i := 1 to NoCases do
|
|
begin
|
|
if (not GoodRecord(OS3mainFrm.DataGrid, i, 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 > 2) then
|
|
begin
|
|
ErrorMsg('Group codes must be 1 and 2!');
|
|
exit;
|
|
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
|
|
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 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
|
|
break;
|
|
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;
|
|
|
|
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 := 0 to total_n-1 do
|
|
begin
|
|
group := round(Ranks[i, 1]);
|
|
RankSums[group-1] := RankSums[group-1] + Ranks[i, 0];
|
|
end;
|
|
|
|
// Calculate U for larger and smaller groups
|
|
n1 := group_count[0];
|
|
n2 := group_count[1];
|
|
if (n1 > n2) then
|
|
U := n1 * n2 + n1 * (n1 + 1) / 2.0 - RankSums[0]
|
|
else
|
|
U := n1 * n2 + n2 * (n2 + 1) / 2.0 - RankSums[1];
|
|
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);
|
|
|
|
// Setup for printer output
|
|
lReport := TStringList.Create;
|
|
try
|
|
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(' Score Rank Group');
|
|
lReport.Add('');
|
|
for i := 0 to total_n-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 noGroups-1 do
|
|
lReport.Add('%3d %10.2f %5d', [i+min_grp, RankSums[i], group_count[i]]);
|
|
lReport.Add('');
|
|
lReport.Add('No. of tied rank groups: %10d', [NoTieGroups]);
|
|
if (n1 > n2) then
|
|
largestn := n1
|
|
else
|
|
largestn := n2;
|
|
if (largestn < 20) then
|
|
outline := format('Statistic U: %26.4f',[U])
|
|
else
|
|
begin
|
|
if (U > U2) then
|
|
outline := format('Statistic U: %26.4f',[U])
|
|
else
|
|
outline := format('Statistic U: %26.4f',[U2]);
|
|
end;
|
|
lReport.Add(outline);
|
|
lReport.Add('z Statistic (corrected for ties): %8.4f', [z]);
|
|
lReport.Add(' Probability > 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;
|
|
|
|
FReportFrame.DisplayReport(lReport);
|
|
|
|
finally
|
|
lReport.Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TMannWhitUForm.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 TMannWhitUForm.DepOutClick(Sender: TObject);
|
|
begin
|
|
if DepEdit.Text <> '' then
|
|
begin
|
|
VarList.Items.Add(DepEdit.Text);
|
|
DepEdit.Text := '';
|
|
end;
|
|
UpdateBtnStates;
|
|
end;
|
|
|
|
|
|
procedure TMannWhitUForm.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 TMannWhitUForm.GrpOutClick(Sender: TObject);
|
|
begin
|
|
if GrpEdit.Text <> '' then
|
|
begin
|
|
VarList.Items.Add(GrpEdit.Text);
|
|
GrpEdit.Text := '';
|
|
end;
|
|
UpdateBtnStates;
|
|
end;
|
|
|
|
|
|
procedure TMannWhitUForm.Reset;
|
|
var
|
|
i: integer;
|
|
begin
|
|
inherited;
|
|
GrpEdit.Clear;
|
|
DepEdit.clear;
|
|
VarList.Items.Clear;
|
|
for i := 1 to NoVariables do
|
|
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
|
|
UpdateBtnStates;
|
|
end;
|
|
|
|
|
|
procedure TMannWhitUForm.UpdateBtnStates;
|
|
begin
|
|
inherited;
|
|
GrpIn.Enabled := (VarList.ItemIndex > -1) and (GrpEdit.Text = '');
|
|
DepIn.Enabled := (VarList.ItemIndex > -1) and (DepEdit.Text = '');
|
|
GrpOut.Enabled := GrpEdit.Text <> '';
|
|
DepOut.Enabled := DepEdit.Text <> '';
|
|
end;
|
|
|
|
|
|
procedure TMannWhitUForm.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 TMannWhitUForm.VarListSelectionChange(Sender: TObject; User: boolean);
|
|
begin
|
|
UpdateBtnStates;
|
|
end;
|
|
|
|
end.
|
|
|