You've already forked lazarus-ccr
aac25fbe8d
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7829 8e941d3f-bd1b-0410-a28a-d453659cc2b4
429 lines
9.7 KiB
ObjectPascal
429 lines
9.7 KiB
ObjectPascal
unit FriedmanUnit;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
|
|
StdCtrls, Buttons, ExtCtrls,
|
|
MainUnit, Globals, DataProcs, FunctionsLib, MatrixLib, BasicStatsReportFormUnit;
|
|
|
|
type
|
|
|
|
{ TFriedmanFrm }
|
|
|
|
TFriedmanFrm = class(TBasicStatsReportForm)
|
|
GrpVar: TEdit;
|
|
GrpIn: TBitBtn;
|
|
GrpOut: TBitBtn;
|
|
Label2: TLabel;
|
|
Label3: TLabel;
|
|
TreatVars: TListBox;
|
|
TrtIn: TBitBtn;
|
|
TrtOut: TBitBtn;
|
|
Label1: TLabel;
|
|
VarList: TListBox;
|
|
procedure GrpInClick(Sender: TObject);
|
|
procedure GrpOutClick(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
|
|
|
|
protected
|
|
procedure AdjustConstraints; override;
|
|
procedure Compute; override;
|
|
procedure UpdateBtnStates; override;
|
|
function Validate(out AMsg: String; out AControl: TWinControl): boolean; override;
|
|
|
|
public
|
|
procedure Reset; override;
|
|
end;
|
|
|
|
var
|
|
FriedmanFrm: TFriedmanFrm;
|
|
|
|
|
|
implementation
|
|
|
|
{$R *.lfm}
|
|
|
|
uses
|
|
Utils;
|
|
|
|
|
|
{ TFriedmanFrm }
|
|
|
|
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 := '';
|
|
for i := 1 to NoVariables do
|
|
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
|
|
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;
|
|
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.UpdateBtnStates;
|
|
var
|
|
lSelected: Boolean;
|
|
begin
|
|
inherited;
|
|
lSelected := AnySelected(VarList);
|
|
GrpIn.Enabled := lSelected and (GrpVar.Text = '');
|
|
TrtIn.Enabled := lSelected;
|
|
GrpOut.Enabled := GrpVar.Text <> '';
|
|
TrtOut.Enabled := AnySelected(TreatVars)
|
|
end;
|
|
|
|
|
|
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.
|
|
|