pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity
Files
c95d86dba082c99173b6dc50f714c99dba0938a4
lazarus-ccr/applications/lazstats/source_orig/mannwhituunit.pas
wp_xxyyzz e1c5977e0d LazStats: Adding original source, part 6. 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7885 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2020-11-16 11:16:49 +00:00

327 lines
9.0 KiB
ObjectPascal
Raw Blame History

unit MannWhitUUnit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, Buttons, MainUnit, OutPutUnit, FunctionslIB,
Globals, DataProcs, Math;
type
{ TMannWhitUFrm }
TMannWhitUFrm = class(TForm)
GrpIn: TBitBtn;
GrpOut: TBitBtn;
DepIn: TBitBtn;
DepOut: TBitBtn;
ResetBtn: TButton;
CancelBtn: TButton;
ComputeBtn: TButton;
ReturnBtn: TButton;
GrpEdit: TEdit;
DepEdit: TEdit;
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
MannWhitUFrm: TMannWhitUFrm;
implementation
{ TMannWhitUFrm }
procedure TMannWhitUFrm.ResetBtnClick(Sender: TObject);
VAR i : integer;
begin
GrpEdit.Text := '';
DepEdit.Text := '';
GrpIn.Visible := true;
GrpOut.Visible := false;
DepIn.Visible := true;
DepOut.Visible := false;
VarList.Items.Clear;
for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
end;
procedure TMannWhitUFrm.FormShow(Sender: TObject);
begin
ResetBtnClick(self);
end;
procedure TMannWhitUFrm.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 TMannWhitUFrm.ComputeBtnClick(Sender: TObject);
label cleanup, Check1;
var
i, j, ind_var, dep_var, min_grp, max_grp, group, total_n : integer;
NoTies, NoTieGroups, n1, n2, nogroups, largestn : integer;
NoSelected : integer;
ColNoSelected : IntDyneVec;
group_count : IntdyneVec;
Ranks, X : DblDyneMat;
RankSums : DblDyneVec;
TieSum, score, t, SumT, Avg, z, prob, U, U2, SD, Temp : double;
cellstring, outline : string;
begin
total_n := 0;
NoTieGroups := 0;
NoSelected := 2;
SumT := 0.0;
// Check for data
if (NoVariables < 1) then
begin
ShowMessage('ERROR! You must have grid data!');
exit;
end;
// allocate space
SetLength(ColNoSelected,NoVariables);
// 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
min_grp := 10000;
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;
// 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;
// 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('');
// 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 > 2) then
begin
ShowMessage('ERROR! Group codes must be 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 := 1 to total_n do
begin
Ranks[i-1,0] := i;
Ranks[i-1,1] := X[i-1,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 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);
//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);
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;
// Clean up the heap
cleanup:
group_count := nil;
X := nil;
Ranks := nil;
RankSums := nil;
ColNoSelected := nil;
end;
procedure TMannWhitUFrm.DepOutClick(Sender: TObject);
begin
VarList.Items.Add(DepEdit.Text);
DepEdit.Text := '';
DepIn.Visible := true;
DepOut.Visible := false;
end;
procedure TMannWhitUFrm.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 TMannWhitUFrm.GrpOutClick(Sender: TObject);
begin
VarList.Items.Add(GrpEdit.Text);
GrpEdit.Text := '';
GrpIn.Visible := true;
GrpOut.Visible := false;
end;
initialization
{$I mannwhituunit.lrs}
end.
Reference in New Issue View Git Blame Copy Permalink