You've already forked lazarus-ccr
435 lines
11 KiB
ObjectPascal
435 lines
11 KiB
ObjectPascal
|
unit FriedmanUnit;
|
||
|
|
|
||
|
|
{$mode objfpc}{$H+}
|
||
|
|
|
||
|
|
interface
|
||
|
|
|
||
|
|
uses
|
||
|
|
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
||
|
|
StdCtrls, Buttons, ExtCtrls,
|
||
|
|
MainUnit, Globals, OutPutUnit, DataProcs, FunctionsLib, MatrixLib,
|
||
|
|
ContextHelpUnit;
|
||
|
|
|
||
|
|
type
|
||
|
|
|
||
|
|
{ TFriedmanFrm }
|
||
|
|
|
||
|
|
TFriedmanFrm = class(TForm)
|
||
|
|
Bevel1: TBevel;
|
||
|
|
HelpBtn: TButton;
|
||
|
|
Panel1: TPanel;
|
||
|
|
ResetBtn: TButton;
|
||
|
|
ComputeBtn: TButton;
|
||
|
|
CloseBtn: TButton;
|
||
|
|
GrpVar: TEdit;
|
||
|
|
GrpIn: TBitBtn;
|
||
|
|
GrpOut: TBitBtn;
|
||
|
|
Label2: TLabel;
|
||
|
|
Label3: TLabel;
|
||
|
|
TreatVars: TListBox;
|
||
|
|
TrtIn: TBitBtn;
|
||
|
|
TrtOut: TBitBtn;
|
||
|
|
Label1: TLabel;
|
||
|
|
VarList: TListBox;
|
||
|
|
procedure ComputeBtnClick(Sender: TObject);
|
||
|
|
procedure FormActivate(Sender: TObject);
|
||
|
|
procedure FormCreate(Sender: TObject);
|
||
|
|
procedure FormShow(Sender: TObject);
|
||
|
|
procedure GrpInClick(Sender: TObject);
|
||
|
|
procedure GrpOutClick(Sender: TObject);
|
||
|
|
procedure HelpBtnClick(Sender: TObject);
|
||
|
|
procedure ResetBtnClick(Sender: TObject);
|
||
|
|
procedure TrtInClick(Sender: TObject);
|
||
|
|
procedure TrtOutClick(Sender: TObject);
|
||
|
|
procedure VarListSelectionChange(Sender: TObject; User: boolean);
|
||
|
|
private
|
||
|
|
{ private declarations }
|
||
|
|
FAutosized: Boolean;
|
||
|
|
procedure UpdateBtnStates;
|
||
|
|
public
|
||
|
|
{ public declarations }
|
||
|
|
end;
|
||
|
|
|
||
|
|
var
|
||
|
|
FriedmanFrm: TFriedmanFrm;
|
||
|
|
|
||
|
|
implementation
|
||
|
|
|
||
|
|
uses
|
||
|
|
Math;
|
||
|
|
|
||
|
|
{ TFriedmanFrm }
|
||
|
|
|
||
|
|
procedure TFriedmanFrm.ResetBtnClick(Sender: TObject);
|
||
|
|
var
|
||
|
|
i: integer;
|
||
|
|
begin
|
||
|
|
VarList.Items.Clear;
|
||
|
|
TreatVars.Items.Clear;
|
||
|
|
GrpVar.Text := '';
|
||
|
|
for i := 1 to NoVariables do
|
||
|
|
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
|
||
|
|
UpdateBtnStates;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TFriedmanFrm.TrtInClick(Sender: TObject);
|
||
|
|
var
|
||
|
|
i: integer;
|
||
|
|
begin
|
||
|
|
i := 0;
|
||
|
|
while i < VarList.Items.Count do
|
||
|
|
begin
|
||
|
|
if VarList.Selected[i] then
|
||
|
|
begin
|
||
|
|
TreatVars.Items.Add(VarList.Items[i]);
|
||
|
|
VarList.Items.Delete(i);
|
||
|
|
i := 0;
|
||
|
|
end
|
||
|
|
else
|
||
|
|
inc(i);
|
||
|
|
end;
|
||
|
|
UpdateBtnStates;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TFriedmanFrm.TrtOutClick(Sender: TObject);
|
||
|
|
var
|
||
|
|
i: Integer;
|
||
|
|
begin
|
||
|
|
i := 0;
|
||
|
|
while i < TreatVars.Items.Count do
|
||
|
|
begin
|
||
|
|
if TreatVars.Selected[i] then
|
||
|
|
begin
|
||
|
|
VarList.Items.Add(TreatVars.Items[i]);
|
||
|
|
TreatVars.Items.Delete(i);
|
||
|
|
i := 0;
|
||
|
|
end else
|
||
|
|
inc(i);
|
||
|
|
end;
|
||
|
|
UpdateBtnStates;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TFriedmanFrm.VarListSelectionChange(Sender: TObject; User: boolean);
|
||
|
|
begin
|
||
|
|
UpdateBtnStates;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TFriedmanFrm.FormActivate(Sender: TObject);
|
||
|
|
var
|
||
|
|
w: Integer;
|
||
|
|
begin
|
||
|
|
if FAutoSized then
|
||
|
|
exit;
|
||
|
|
|
||
|
|
w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]);
|
||
|
|
HelpBtn.Constraints.MinWidth := w;
|
||
|
|
ResetBtn.Constraints.MinWidth := w;
|
||
|
|
ComputeBtn.Constraints.MinWidth := w;
|
||
|
|
CloseBtn.Constraints.MinWidth := w;
|
||
|
|
|
||
|
|
Constraints.MinWidth := Width;
|
||
|
|
Constraints.MinHeight := Height;
|
||
|
|
|
||
|
|
FAutoSized := true;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TFriedmanFrm.FormCreate(Sender: TObject);
|
||
|
|
begin
|
||
|
|
Assert(OS3MainFrm <> nil);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TFriedmanFrm.FormShow(Sender: TObject);
|
||
|
|
begin
|
||
|
|
ResetBtnClick(self);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TFriedmanFrm.ComputeBtnClick(Sender: TObject);
|
||
|
|
Var
|
||
|
|
i, j, k, L, col, itemp, GrpCol, mingrp, maxgrp : integer;
|
||
|
|
tiestart, tieend, NoSelected, NCases, group, nogrps : integer;
|
||
|
|
s, t, TotRanks, chisqr, probchi, score : double;
|
||
|
|
X, ColRanks : DblDyneVec;
|
||
|
|
Ranks, means : DblDyneMat;
|
||
|
|
RowLabels, ColLabels : StrDyneVec;
|
||
|
|
index : IntDyneVec;
|
||
|
|
GrpNo : IntdyneMat;
|
||
|
|
cellstring, outline: string;
|
||
|
|
title : string;
|
||
|
|
ties : boolean;
|
||
|
|
ColNoSelected : IntDyneVec;
|
||
|
|
lReport: TStrings;
|
||
|
|
begin
|
||
|
|
if GrpVar.Text = '' then begin
|
||
|
|
MessageDlg('Group variable not selected.', mtError, [mbOK], 0);
|
||
|
|
exit;
|
||
|
|
end;
|
||
|
|
|
||
|
|
if TreatVars.Items.Count = 0 then
|
||
|
|
begin
|
||
|
|
MessageDlg('No treatment variable selected.', mtError, [mbOK], 0);
|
||
|
|
exit;
|
||
|
|
end;
|
||
|
|
|
||
|
|
k := TreatVars.Items.Count;
|
||
|
|
NoSelected := k + 1;
|
||
|
|
SetLength(ColNoSelected,NoVariables);
|
||
|
|
SetLength(ColLabels,NoVariables);
|
||
|
|
|
||
|
|
// get group variable and treatment variables
|
||
|
|
GrpCol := 0;
|
||
|
|
for i := 1 to NoVariables do
|
||
|
|
begin
|
||
|
|
cellstring := OS3MainFrm.DataGrid.Cells[i,0];
|
||
|
|
if cellstring = GrpVar.Text then
|
||
|
|
begin
|
||
|
|
ColNoSelected[0] := i;
|
||
|
|
GrpCol := i;
|
||
|
|
end;
|
||
|
|
for j := 1 to k do
|
||
|
|
begin
|
||
|
|
if cellstring = TreatVars.Items.Strings[j-1] then
|
||
|
|
begin
|
||
|
|
ColNoSelected[j] := i;
|
||
|
|
ColLabels[j-1] := cellstring;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
// get minimum and maximum group codes
|
||
|
|
NCases := 0;
|
||
|
|
mingrp := 10000;
|
||
|
|
maxgrp := -10000;
|
||
|
|
for i := 1 to NoCases do
|
||
|
|
begin
|
||
|
|
if not GoodRecord(i,NoSelected,ColNoSelected) then continue;
|
||
|
|
NCases := NCases + 1;
|
||
|
|
group := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[GrpCol,i])));
|
||
|
|
if group > maxgrp then maxgrp := group;
|
||
|
|
if group < mingrp then mingrp := group;
|
||
|
|
end;
|
||
|
|
nogrps := maxgrp - mingrp + 1;
|
||
|
|
|
||
|
|
// Initialize arrays
|
||
|
|
SetLength(RowLabels,nogrps);
|
||
|
|
SetLength(index,k);
|
||
|
|
SetLength(GrpNo,nogrps,k);
|
||
|
|
SetLength(Ranks,nogrps,k);
|
||
|
|
SetLength(means,nogrps,k);
|
||
|
|
SetLength(X,k);
|
||
|
|
SetLength(ColRanks,k);
|
||
|
|
for j := 0 to k-1 do
|
||
|
|
begin
|
||
|
|
for i := 0 to nogrps-1 do
|
||
|
|
begin
|
||
|
|
means[i,j] := 0.0;
|
||
|
|
Ranks[i,j] := 0.0;
|
||
|
|
GrpNo[i,j] := 0;
|
||
|
|
end;
|
||
|
|
ColRanks[j] := 0.0;
|
||
|
|
X[j] := 0.0;
|
||
|
|
index[j] := j+1;
|
||
|
|
end;
|
||
|
|
|
||
|
|
// Initialize labels
|
||
|
|
for i := 1 to nogrps do
|
||
|
|
begin
|
||
|
|
cellstring := format('Group %d',[mingrp + i - 1]);
|
||
|
|
RowLabels[i-1] := cellstring;
|
||
|
|
end;
|
||
|
|
|
||
|
|
// Setup for printing results
|
||
|
|
lReport := TStringList.Create;
|
||
|
|
try
|
||
|
|
lReport.Add('FRIEDMAN TWO-WAY ANOVA ON RANKS');
|
||
|
|
lReport.Add('See pages 166-173 in S. Siegel''s Nonparametric Statistics');
|
||
|
|
lReport.Add('for the Behavioral Sciences, McGraw-Hill Book Co., New York, 1956');
|
||
|
|
lReport.Add('');
|
||
|
|
|
||
|
|
// Obtain mean score for each cell
|
||
|
|
for i := 1 to NoCases do
|
||
|
|
begin
|
||
|
|
if ( not GoodRecord(i,NoSelected,ColNoSelected)) then continue;
|
||
|
|
group := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[GrpCol,i])));
|
||
|
|
group := group - mingrp + 1;
|
||
|
|
for j := 1 to k do // treatment values
|
||
|
|
begin
|
||
|
|
col := ColNoSelected[j];
|
||
|
|
score := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,i]));
|
||
|
|
means[group-1,j-1] := means[group-1,j-1] + score;
|
||
|
|
GrpNo[group-1,j-1] := GrpNo[group-1,j-1] + 1;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
for i := 1 to nogrps do
|
||
|
|
for j := 1 to k do
|
||
|
|
means[i-1,j-1] := means[i-1,j-1] / GrpNo[i-1,j-1];
|
||
|
|
|
||
|
|
// Print means and group size arrays
|
||
|
|
title := 'Treatment means - values to be ranked.';
|
||
|
|
MatPrint(means,nogrps,k,title,RowLabels,ColLabels,NCases, lReport);
|
||
|
|
title := 'Number in each group''s treatment.';
|
||
|
|
IntArrayPrint(GrpNo,nogrps,k,'GROUP',RowLabels,ColLabels,title, lReport);
|
||
|
|
|
||
|
|
// Gather row data in X array and rank within rows
|
||
|
|
for i := 0 to nogrps-1 do
|
||
|
|
begin
|
||
|
|
for j := 0 to k-1 do
|
||
|
|
begin
|
||
|
|
X[j] := means[i,j];
|
||
|
|
index[j] := j+1;
|
||
|
|
end;
|
||
|
|
|
||
|
|
//rank scores in this row i
|
||
|
|
for j := 1 to k - 1 do
|
||
|
|
begin
|
||
|
|
for L := j + 1 to k do
|
||
|
|
begin
|
||
|
|
if (X[j-1] > X[L-1]) then
|
||
|
|
begin
|
||
|
|
t := X[j-1];
|
||
|
|
X[j-1] := X[L-1];
|
||
|
|
X[L-1] := t;
|
||
|
|
itemp := index[j-1];
|
||
|
|
index[j-1] := index[L-1];
|
||
|
|
index[L-1] := itemp;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
for j := 1 to k do
|
||
|
|
begin
|
||
|
|
Ranks[i,index[j-1]-1] := j;
|
||
|
|
end;
|
||
|
|
|
||
|
|
//Check for tied ranks and use average if desired here
|
||
|
|
tiestart := 0;
|
||
|
|
tieend := 0;
|
||
|
|
ties := false;
|
||
|
|
j := 1;
|
||
|
|
while j < k do
|
||
|
|
begin
|
||
|
|
for L := j + 1 to k do
|
||
|
|
begin
|
||
|
|
if (means[i,j-1] = means[i,L-1]) then
|
||
|
|
begin
|
||
|
|
ties := true;
|
||
|
|
tiestart := j;
|
||
|
|
tieend := L;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
if (ties = true) then
|
||
|
|
begin
|
||
|
|
s := 0.0;
|
||
|
|
for L := tiestart to tieend do s := s + Ranks[i,L-1];
|
||
|
|
for L := tiestart to tieend do
|
||
|
|
Ranks[i,L-1] := s / (tieend - tiestart + 1);
|
||
|
|
j := tieend;
|
||
|
|
ties := false;
|
||
|
|
end;
|
||
|
|
j := j + 1;
|
||
|
|
end; // next j
|
||
|
|
end; // next group i
|
||
|
|
|
||
|
|
//Get sum of ranks in columns
|
||
|
|
for i := 1 to nogrps do
|
||
|
|
for j := 1 to k do
|
||
|
|
ColRanks[j-1] := ColRanks[j-1] + Ranks[i-1,j-1];
|
||
|
|
|
||
|
|
//Calculate Statistics
|
||
|
|
TotRanks := 0;
|
||
|
|
for j := 1 to k do TotRanks := TotRanks + (ColRanks[j-1] * ColRanks[j-1]);
|
||
|
|
chisqr := TotRanks * 12.0 / (nogrps * k * (k + 1));
|
||
|
|
chisqr := chisqr - (3 * nogrps * (k + 1));
|
||
|
|
probchi := 1.0 - chisquaredprob(chisqr, k - 1);
|
||
|
|
|
||
|
|
//Now, show results
|
||
|
|
title := 'Score Rankings Within Groups';
|
||
|
|
MatPrint(Ranks,nogrps,k,title,RowLabels,ColLabels,NCases, lReport);
|
||
|
|
title := 'TOTAL RANKS';
|
||
|
|
DynVectorPrint(ColRanks,k,title,ColLabels,NCases, lReport);
|
||
|
|
lReport.Add('');
|
||
|
|
lReport.Add('Chi-square with %d D.F.: %.3f with probability %.4f', [k-1, chisqr, probchi]);
|
||
|
|
if ((k < 5) and (nogrps < 10)) then
|
||
|
|
begin
|
||
|
|
lReport.Add('Chi-square too approximate-use exact table (TABLE N)');
|
||
|
|
lReport.Add('page 280-281 in Siegel');
|
||
|
|
end;
|
||
|
|
|
||
|
|
DisplayReport(lReport);
|
||
|
|
|
||
|
|
finally
|
||
|
|
lReport.Free;
|
||
|
|
ColRanks := nil;
|
||
|
|
X := nil;
|
||
|
|
means := nil;
|
||
|
|
Ranks := nil;
|
||
|
|
GrpNo := nil;
|
||
|
|
index := nil;
|
||
|
|
RowLabels := nil;
|
||
|
|
ColLabels := nil;
|
||
|
|
ColNoSelected := nil;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TFriedmanFrm.GrpInClick(Sender: TObject);
|
||
|
|
var
|
||
|
|
index: integer;
|
||
|
|
begin
|
||
|
|
index := VarList.ItemIndex;
|
||
|
|
if (index > -1) and (GrpVar.Text = '') then
|
||
|
|
begin
|
||
|
|
GrpVar.Text := VarList.Items[index];
|
||
|
|
VarList.Items.Delete(index);
|
||
|
|
end;
|
||
|
|
UpdateBtnStates;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TFriedmanFrm.GrpOutClick(Sender: TObject);
|
||
|
|
begin
|
||
|
|
if GrpVar.Text <> '' then
|
||
|
|
begin
|
||
|
|
VarList.Items.Add(GrpVar.Text);
|
||
|
|
GrpVar.Text := '';
|
||
|
|
end;
|
||
|
|
UpdateBtnStates;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TFriedmanFrm.HelpBtnClick(Sender: TObject);
|
||
|
|
begin
|
||
|
|
if ContextHelpForm = nil then
|
||
|
|
Application.CreateForm(TContextHelpForm, ContextHelpForm);
|
||
|
|
ContextHelpForm.HelpMessage((Sender as TButton).Tag);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TFriedmanFrm.UpdateBtnStates;
|
||
|
|
var
|
||
|
|
i: Integer;
|
||
|
|
lSelected: Boolean;
|
||
|
|
begin
|
||
|
|
lSelected := false;
|
||
|
|
for i:= 0 to VarList.Items.Count-1 do
|
||
|
|
if VarList.Selected[i] then
|
||
|
|
begin
|
||
|
|
lSelected := true;
|
||
|
|
break;
|
||
|
|
end;
|
||
|
|
GrpIn.Enabled := lSelected and (GrpVar.Text = '');
|
||
|
|
TrtIn.Enabled := lSelected;
|
||
|
|
|
||
|
|
GrpOut.Enabled := GrpVar.Text <> '';
|
||
|
|
|
||
|
|
lSelected := false;
|
||
|
|
for i := 0 to TreatVars.Items.Count-1 do
|
||
|
|
if TreatVars.Selected[i] then
|
||
|
|
begin
|
||
|
|
lSelected := true;
|
||
|
|
break;
|
||
|
|
end;
|
||
|
|
TrtOut.Enabled := lSelected;
|
||
|
|
end;
|
||
|
|
|
||
|
|
|
||
|
|
initialization
|
||
|
|
{$I friedmanunit.lrs}
|
||
|
|
|
||
|
|
end.
|
||
|
|
|