You've already forked lazarus-ccr
LazStats: Inherit FriedmanUnit from TBasicStatsReportForm
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7815 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@ -1,126 +1,34 @@
|
||||
object FriedmanFrm: TFriedmanFrm
|
||||
inherited FriedmanFrm: TFriedmanFrm
|
||||
Left = 540
|
||||
Height = 330
|
||||
Height = 273
|
||||
Top = 186
|
||||
Width = 418
|
||||
Width = 609
|
||||
HelpType = htKeyword
|
||||
HelpKeyword = 'html/FriedmanTwoWayANOVA.htm'
|
||||
AutoSize = True
|
||||
Caption = 'The Friedman Two Way ANOVA on Ranks'
|
||||
ClientHeight = 330
|
||||
ClientWidth = 418
|
||||
OnActivate = FormActivate
|
||||
OnCreate = FormCreate
|
||||
OnShow = FormShow
|
||||
Position = poMainFormCenter
|
||||
LCLVersion = '2.1.0.0'
|
||||
object ResetBtn: TButton
|
||||
AnchorSideRight.Control = ComputeBtn
|
||||
AnchorSideBottom.Control = Owner
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 209
|
||||
Height = 25
|
||||
Top = 297
|
||||
Width = 54
|
||||
Anchors = [akRight, akBottom]
|
||||
AutoSize = True
|
||||
BorderSpacing.Left = 8
|
||||
BorderSpacing.Top = 8
|
||||
BorderSpacing.Right = 8
|
||||
BorderSpacing.Bottom = 8
|
||||
Caption = 'Reset'
|
||||
OnClick = ResetBtnClick
|
||||
TabOrder = 2
|
||||
end
|
||||
object ComputeBtn: TButton
|
||||
AnchorSideRight.Control = CloseBtn
|
||||
AnchorSideBottom.Control = Owner
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 271
|
||||
Height = 25
|
||||
Top = 297
|
||||
Width = 76
|
||||
Anchors = [akRight, akBottom]
|
||||
AutoSize = True
|
||||
BorderSpacing.Left = 8
|
||||
BorderSpacing.Top = 8
|
||||
BorderSpacing.Right = 8
|
||||
BorderSpacing.Bottom = 8
|
||||
Caption = 'Compute'
|
||||
OnClick = ComputeBtnClick
|
||||
TabOrder = 3
|
||||
end
|
||||
object CloseBtn: TButton
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = Owner
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 355
|
||||
Height = 25
|
||||
Top = 297
|
||||
Width = 55
|
||||
Anchors = [akRight, akBottom]
|
||||
AutoSize = True
|
||||
BorderSpacing.Left = 8
|
||||
BorderSpacing.Top = 8
|
||||
BorderSpacing.Right = 8
|
||||
BorderSpacing.Bottom = 8
|
||||
Caption = 'Close'
|
||||
ModalResult = 11
|
||||
TabOrder = 4
|
||||
end
|
||||
object HelpBtn: TButton
|
||||
Tag = 124
|
||||
AnchorSideRight.Control = ResetBtn
|
||||
AnchorSideBottom.Control = Owner
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 150
|
||||
Height = 25
|
||||
Top = 297
|
||||
Width = 51
|
||||
Anchors = [akRight, akBottom]
|
||||
AutoSize = True
|
||||
BorderSpacing.Left = 8
|
||||
BorderSpacing.Top = 8
|
||||
BorderSpacing.Right = 8
|
||||
BorderSpacing.Bottom = 8
|
||||
Caption = 'Help'
|
||||
OnClick = HelpBtnClick
|
||||
TabOrder = 1
|
||||
end
|
||||
object ButtonBevel: TBevel
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = CloseBtn
|
||||
Left = 0
|
||||
Height = 8
|
||||
Top = 281
|
||||
Width = 418
|
||||
Anchors = [akLeft, akRight, akBottom]
|
||||
Shape = bsBottomLine
|
||||
end
|
||||
object Panel1: TPanel
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = Owner
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = ButtonBevel
|
||||
Left = 8
|
||||
Height = 273
|
||||
Top = 8
|
||||
Width = 402
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
BorderSpacing.Left = 8
|
||||
BorderSpacing.Top = 8
|
||||
BorderSpacing.Right = 8
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 273
|
||||
ClientWidth = 402
|
||||
TabOrder = 0
|
||||
object Label1: TLabel
|
||||
AnchorSideLeft.Control = Panel1
|
||||
AnchorSideTop.Control = Panel1
|
||||
ClientHeight = 273
|
||||
ClientWidth = 609
|
||||
inherited ParamsPanel: TPanel
|
||||
Height = 257
|
||||
ClientHeight = 257
|
||||
inherited CloseBtn: TButton
|
||||
Top = 232
|
||||
end
|
||||
inherited ComputeBtn: TButton
|
||||
Top = 232
|
||||
end
|
||||
inherited ResetBtn: TButton
|
||||
Top = 232
|
||||
end
|
||||
inherited HelpBtn: TButton
|
||||
Top = 232
|
||||
end
|
||||
inherited ButtonBevel: TBevel
|
||||
Top = 216
|
||||
end
|
||||
object Label1: TLabel[5]
|
||||
AnchorSideLeft.Control = ParamsPanel
|
||||
AnchorSideTop.Control = ParamsPanel
|
||||
Left = 0
|
||||
Height = 15
|
||||
Top = 0
|
||||
@ -129,144 +37,147 @@ object FriedmanFrm: TFriedmanFrm
|
||||
Caption = 'Available Variables'
|
||||
ParentColor = False
|
||||
end
|
||||
object Label2: TLabel
|
||||
object Label2: TLabel[6]
|
||||
AnchorSideLeft.Control = GrpVar
|
||||
AnchorSideBottom.Control = GrpVar
|
||||
Left = 223
|
||||
Left = 164
|
||||
Height = 15
|
||||
Top = 32
|
||||
Top = 30
|
||||
Width = 77
|
||||
Anchors = [akLeft, akBottom]
|
||||
BorderSpacing.Bottom = 2
|
||||
Caption = 'Group Variable'
|
||||
ParentColor = False
|
||||
end
|
||||
object Label3: TLabel
|
||||
object Label3: TLabel[7]
|
||||
AnchorSideLeft.Control = TreatVars
|
||||
AnchorSideTop.Control = TrtIn
|
||||
AnchorSideBottom.Control = TreatVars
|
||||
Left = 223
|
||||
Left = 164
|
||||
Height = 15
|
||||
Top = 116
|
||||
Top = 114
|
||||
Width = 102
|
||||
BorderSpacing.Bottom = 2
|
||||
Caption = 'Treatment Variables'
|
||||
ParentColor = False
|
||||
end
|
||||
object VarList: TListBox
|
||||
AnchorSideLeft.Control = Panel1
|
||||
object VarList: TListBox[8]
|
||||
AnchorSideLeft.Control = ParamsPanel
|
||||
AnchorSideTop.Control = Label1
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = GrpIn
|
||||
AnchorSideBottom.Control = Panel1
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 0
|
||||
Height = 258
|
||||
Height = 201
|
||||
Top = 15
|
||||
Width = 179
|
||||
Width = 126
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
BorderSpacing.Right = 8
|
||||
Constraints.MinHeight = 220
|
||||
BorderSpacing.Right = 6
|
||||
ItemHeight = 0
|
||||
MultiSelect = True
|
||||
OnDblClick = VarListDblClick
|
||||
OnSelectionChange = VarListSelectionChange
|
||||
TabOrder = 0
|
||||
TabOrder = 4
|
||||
end
|
||||
object GrpIn: TBitBtn
|
||||
AnchorSideLeft.Control = Panel1
|
||||
object GrpIn: TBitBtn[9]
|
||||
AnchorSideLeft.Control = ParamsPanel
|
||||
AnchorSideLeft.Side = asrCenter
|
||||
Left = 187
|
||||
Height = 28
|
||||
Left = 132
|
||||
Height = 26
|
||||
Top = 22
|
||||
Width = 28
|
||||
Width = 26
|
||||
Images = MainDataModule.ImageList
|
||||
ImageIndex = 1
|
||||
OnClick = GrpInClick
|
||||
Spacing = 0
|
||||
TabOrder = 1
|
||||
TabOrder = 5
|
||||
end
|
||||
object GrpOut: TBitBtn
|
||||
AnchorSideLeft.Control = Panel1
|
||||
object GrpOut: TBitBtn[10]
|
||||
AnchorSideLeft.Control = ParamsPanel
|
||||
AnchorSideLeft.Side = asrCenter
|
||||
Left = 187
|
||||
Height = 28
|
||||
Left = 132
|
||||
Height = 26
|
||||
Top = 56
|
||||
Width = 28
|
||||
Width = 26
|
||||
Images = MainDataModule.ImageList
|
||||
ImageIndex = 0
|
||||
OnClick = GrpOutClick
|
||||
Spacing = 0
|
||||
TabOrder = 2
|
||||
TabOrder = 6
|
||||
end
|
||||
object TrtIn: TBitBtn
|
||||
AnchorSideLeft.Control = Panel1
|
||||
object TrtIn: TBitBtn[11]
|
||||
AnchorSideLeft.Control = ParamsPanel
|
||||
AnchorSideLeft.Side = asrCenter
|
||||
AnchorSideTop.Control = GrpOut
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 187
|
||||
Height = 28
|
||||
Top = 116
|
||||
Width = 28
|
||||
Left = 132
|
||||
Height = 26
|
||||
Top = 114
|
||||
Width = 26
|
||||
BorderSpacing.Top = 32
|
||||
Images = MainDataModule.ImageList
|
||||
ImageIndex = 1
|
||||
OnClick = TrtInClick
|
||||
Spacing = 0
|
||||
TabOrder = 4
|
||||
TabOrder = 7
|
||||
end
|
||||
object TrtOut: TBitBtn
|
||||
AnchorSideLeft.Control = Panel1
|
||||
object TrtOut: TBitBtn[12]
|
||||
AnchorSideLeft.Control = ParamsPanel
|
||||
AnchorSideLeft.Side = asrCenter
|
||||
AnchorSideTop.Control = TrtIn
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 187
|
||||
Height = 28
|
||||
Top = 148
|
||||
Width = 28
|
||||
Left = 132
|
||||
Height = 26
|
||||
Top = 144
|
||||
Width = 26
|
||||
BorderSpacing.Top = 4
|
||||
Images = MainDataModule.ImageList
|
||||
ImageIndex = 0
|
||||
OnClick = TrtOutClick
|
||||
Spacing = 0
|
||||
TabOrder = 5
|
||||
TabOrder = 8
|
||||
end
|
||||
object GrpVar: TEdit
|
||||
object GrpVar: TEdit[13]
|
||||
AnchorSideLeft.Control = GrpIn
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideRight.Control = Panel1
|
||||
AnchorSideRight.Control = ParamsPanel
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = GrpOut
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 223
|
||||
Left = 164
|
||||
Height = 23
|
||||
Top = 49
|
||||
Width = 179
|
||||
Top = 47
|
||||
Width = 127
|
||||
Anchors = [akLeft, akRight, akBottom]
|
||||
BorderSpacing.Left = 8
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Bottom = 12
|
||||
ReadOnly = True
|
||||
TabOrder = 3
|
||||
TabOrder = 9
|
||||
Text = 'GrpVar'
|
||||
end
|
||||
object TreatVars: TListBox
|
||||
object TreatVars: TListBox[14]
|
||||
AnchorSideLeft.Control = GrpOut
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = Label3
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = Panel1
|
||||
AnchorSideRight.Control = ParamsPanel
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = VarList
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 223
|
||||
Height = 140
|
||||
Top = 133
|
||||
Width = 179
|
||||
Left = 164
|
||||
Height = 85
|
||||
Top = 131
|
||||
Width = 127
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
BorderSpacing.Left = 8
|
||||
BorderSpacing.Left = 6
|
||||
ItemHeight = 0
|
||||
MultiSelect = True
|
||||
OnDblClick = TreatVarsDblClick
|
||||
OnSelectionChange = VarListSelectionChange
|
||||
TabOrder = 6
|
||||
TabOrder = 10
|
||||
end
|
||||
end
|
||||
inherited ParamsSplitter: TSplitter
|
||||
Height = 273
|
||||
end
|
||||
end
|
||||
|
||||
@ -5,22 +5,15 @@ unit FriedmanUnit;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
|
||||
StdCtrls, Buttons, ExtCtrls,
|
||||
MainUnit, Globals, OutPutUnit, DataProcs, FunctionsLib, MatrixLib,
|
||||
ContextHelpUnit;
|
||||
MainUnit, Globals, DataProcs, FunctionsLib, MatrixLib, BasicStatsReportFormUnit;
|
||||
|
||||
type
|
||||
|
||||
{ TFriedmanFrm }
|
||||
|
||||
TFriedmanFrm = class(TForm)
|
||||
ButtonBevel: TBevel;
|
||||
HelpBtn: TButton;
|
||||
Panel1: TPanel;
|
||||
ResetBtn: TButton;
|
||||
ComputeBtn: TButton;
|
||||
CloseBtn: TButton;
|
||||
TFriedmanFrm = class(TBasicStatsReportForm)
|
||||
GrpVar: TEdit;
|
||||
GrpIn: TBitBtn;
|
||||
GrpOut: TBitBtn;
|
||||
@ -31,39 +24,286 @@ type
|
||||
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 TreatVarsDblClick(Sender: TObject);
|
||||
procedure TrtInClick(Sender: TObject);
|
||||
procedure TrtOutClick(Sender: TObject);
|
||||
procedure VarListDblClick(Sender: TObject);
|
||||
procedure VarListSelectionChange(Sender: TObject; {%H-}User: boolean);
|
||||
private
|
||||
{ private declarations }
|
||||
FAutosized: Boolean;
|
||||
procedure UpdateBtnStates;
|
||||
|
||||
protected
|
||||
procedure AdjustConstraints; override;
|
||||
procedure Compute; override;
|
||||
procedure UpdateBtnStates; override;
|
||||
function Validate(out AMsg: String; out AControl: TWinControl): boolean; override;
|
||||
|
||||
public
|
||||
{ public declarations }
|
||||
procedure Reset; override;
|
||||
end;
|
||||
|
||||
var
|
||||
FriedmanFrm: TFriedmanFrm;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
uses
|
||||
Math, Utils;
|
||||
|
||||
|
||||
{ TFriedmanFrm }
|
||||
|
||||
procedure TFriedmanFrm.ResetBtnClick(Sender: TObject);
|
||||
procedure TFriedmanFrm.AdjustConstraints;
|
||||
begin
|
||||
inherited;
|
||||
|
||||
ParamsPanel.Constraints.MinHeight := TrtOut.Top + TrtOut.Height +
|
||||
ButtonBevel.Height + CloseBtn.BorderSpacing.Top + CloseBtn.Height;
|
||||
ParamsPanel.Constraints.MinWidth := 4*CloseBtn.Width + 3*CloseBtn.BorderSpacing.Left;
|
||||
end;
|
||||
|
||||
|
||||
procedure TFriedmanFrm.Compute;
|
||||
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: DblDyneVec = nil;
|
||||
ColRanks: DblDyneVec = nil;
|
||||
Ranks: DblDyneMat = nil;
|
||||
Means: DblDyneMat = nil;
|
||||
RowLabels: StrDyneVec = nil;
|
||||
ColLabels: StrDyneVec = nil;
|
||||
index : IntDyneVec = nil;
|
||||
GrpNo : IntdyneMat = nil;
|
||||
cellstring: string;
|
||||
title : string;
|
||||
ties : boolean;
|
||||
ColNoSelected : IntDyneVec = nil;
|
||||
lReport: TStrings;
|
||||
begin
|
||||
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 := MaxInt;
|
||||
maxgrp := -MaxInt;
|
||||
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
|
||||
Ranks[i,index[j-1]-1] := j;
|
||||
|
||||
//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;
|
||||
|
||||
FReportFrame.DisplayReport(lReport);
|
||||
|
||||
finally
|
||||
lReport.Free;
|
||||
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.Reset;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
inherited;
|
||||
VarList.Items.Clear;
|
||||
TreatVars.Items.Clear;
|
||||
GrpVar.Text := '';
|
||||
@ -72,6 +312,21 @@ begin
|
||||
UpdateBtnStates;
|
||||
end;
|
||||
|
||||
|
||||
procedure TFriedmanFrm.TreatVarsDblClick(Sender: TObject);
|
||||
var
|
||||
index: Integer;
|
||||
begin
|
||||
index := TreatVars.ItemIndex;
|
||||
if index > -1 then
|
||||
begin
|
||||
VarList.Items.Add(TreatVars.Items[index]);
|
||||
TreatVars.Items.Delete(index);
|
||||
UpdateBtnStates;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TFriedmanFrm.TrtInClick(Sender: TObject);
|
||||
var
|
||||
i: integer;
|
||||
@ -91,6 +346,7 @@ begin
|
||||
UpdateBtnStates;
|
||||
end;
|
||||
|
||||
|
||||
procedure TFriedmanFrm.TrtOutClick(Sender: TObject);
|
||||
var
|
||||
i: Integer;
|
||||
@ -109,301 +365,12 @@ begin
|
||||
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: StrDyneVec = nil;
|
||||
ColLabels: StrDyneVec = nil;
|
||||
index : IntDyneVec;
|
||||
GrpNo : IntdyneMat;
|
||||
cellstring: string;
|
||||
title : string;
|
||||
ties : boolean;
|
||||
ColNoSelected : IntDyneVec = nil;
|
||||
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
|
||||
lSelected: Boolean;
|
||||
begin
|
||||
inherited;
|
||||
lSelected := AnySelected(VarList);
|
||||
GrpIn.Enabled := lSelected and (GrpVar.Text = '');
|
||||
TrtIn.Enabled := lSelected;
|
||||
@ -412,8 +379,50 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
{$I friedmanunit.lrs}
|
||||
function TFriedmanFrm.Validate(out AMsg: String; out AControl: TWinControl): Boolean;
|
||||
begin
|
||||
Result := false;
|
||||
|
||||
if GrpVar.Text = '' then begin
|
||||
AMsg := 'Group variable not selected.';
|
||||
AControl := GrpVar;
|
||||
exit;
|
||||
end;
|
||||
|
||||
if TreatVars.Items.Count = 0 then
|
||||
begin
|
||||
AMsg := 'No treatment variable selected.';
|
||||
AControl := TreatVars;
|
||||
exit;
|
||||
end;
|
||||
|
||||
Result := true;
|
||||
end;
|
||||
|
||||
|
||||
procedure TFriedmanFrm.VarListDblClick(Sender: TObject);
|
||||
var
|
||||
index: Integer;
|
||||
s: String;
|
||||
begin
|
||||
index := VarList.ItemIndex;
|
||||
if index > -1 then
|
||||
begin
|
||||
s := VarList.Items[index];
|
||||
if GrpVar.Text = '' then
|
||||
GrpVar.Text := s
|
||||
else
|
||||
TreatVars.Items.Add(s);
|
||||
VarList.Items.Delete(index);
|
||||
UpdateBtnStates;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFriedmanFrm.VarListSelectionChange(Sender: TObject; User: boolean);
|
||||
begin
|
||||
UpdateBtnStates;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
|
||||
Reference in New Issue
Block a user