You've already forked lazarus-ccr
423 lines
12 KiB
ObjectPascal
423 lines
12 KiB
ObjectPascal
|
unit SpearmanUnit;
|
||
|
|
|
||
|
|
{$mode objfpc}{$H+}
|
||
|
|
|
||
|
|
interface
|
||
|
|
|
||
|
|
uses
|
||
|
|
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
||
|
|
StdCtrls, Buttons, MainUnit, OutPutUnit, FunctionsLib,
|
||
|
|
Globals, DataProcs, Math;
|
||
|
|
|
||
|
|
type
|
||
|
|
|
||
|
|
{ TSpearmanFrm }
|
||
|
|
|
||
|
|
TSpearmanFrm = class(TForm)
|
||
|
|
XIn: TBitBtn;
|
||
|
|
XOut: TBitBtn;
|
||
|
|
YIn: TBitBtn;
|
||
|
|
YOut: TBitBtn;
|
||
|
|
ResetBtn: TButton;
|
||
|
|
CancelBtn: TButton;
|
||
|
|
ComputeBtn: TButton;
|
||
|
|
ReturnBtn: TButton;
|
||
|
|
XEdit: TEdit;
|
||
|
|
YEdit: TEdit;
|
||
|
|
Label1: TLabel;
|
||
|
|
Label2: TLabel;
|
||
|
|
Label3: TLabel;
|
||
|
|
VarList: TListBox;
|
||
|
|
procedure ComputeBtnClick(Sender: TObject);
|
||
|
|
procedure FormShow(Sender: TObject);
|
||
|
|
procedure ResetBtnClick(Sender: TObject);
|
||
|
|
procedure XInClick(Sender: TObject);
|
||
|
|
procedure XOutClick(Sender: TObject);
|
||
|
|
procedure YInClick(Sender: TObject);
|
||
|
|
procedure YOutClick(Sender: TObject);
|
||
|
|
private
|
||
|
|
{ private declarations }
|
||
|
|
public
|
||
|
|
{ public declarations }
|
||
|
|
end;
|
||
|
|
|
||
|
|
var
|
||
|
|
SpearmanFrm: TSpearmanFrm;
|
||
|
|
|
||
|
|
implementation
|
||
|
|
|
||
|
|
{ TSpearmanFrm }
|
||
|
|
|
||
|
|
procedure TSpearmanFrm.ResetBtnClick(Sender: TObject);
|
||
|
|
VAR i : integer;
|
||
|
|
begin
|
||
|
|
XEdit.Text := '';
|
||
|
|
YEdit.Text := '';
|
||
|
|
Xin.Visible := true;
|
||
|
|
Xout.Visible := false;
|
||
|
|
Yin.Visible := true;
|
||
|
|
Yout.Visible := false;
|
||
|
|
VarList.Items.Clear;
|
||
|
|
for i := 1 to NoVariables do
|
||
|
|
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TSpearmanFrm.XInClick(Sender: TObject);
|
||
|
|
VAR index : integer;
|
||
|
|
begin
|
||
|
|
index := VarList.ItemIndex;
|
||
|
|
XEdit.Text := VarList.Items.Strings[index];
|
||
|
|
VarList.Items.Delete(index);
|
||
|
|
Xin.Visible := false;
|
||
|
|
Xout.Visible := true;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TSpearmanFrm.XOutClick(Sender: TObject);
|
||
|
|
begin
|
||
|
|
VarList.Items.Add(XEdit.Text);
|
||
|
|
XEdit.Text := '';
|
||
|
|
Xin.Visible := true;
|
||
|
|
Xout.Visible := false;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TSpearmanFrm.YInClick(Sender: TObject);
|
||
|
|
VAR index : integer;
|
||
|
|
begin
|
||
|
|
index := VarList.ItemIndex;
|
||
|
|
YEdit.Text := VarList.Items.Strings[index];
|
||
|
|
VarList.Items.Delete(index);
|
||
|
|
Yin.Visible := false;
|
||
|
|
Yout.Visible := true;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TSpearmanFrm.YOutClick(Sender: TObject);
|
||
|
|
begin
|
||
|
|
VarList.Items.Add(YEdit.Text);
|
||
|
|
YEdit.Text := '';
|
||
|
|
Yin.Visible := true;
|
||
|
|
Yout.Visible := false;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TSpearmanFrm.FormShow(Sender: TObject);
|
||
|
|
begin
|
||
|
|
ResetBtnClick(self);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TSpearmanFrm.ComputeBtnClick(Sender: TObject);
|
||
|
|
label Check1, Check2;
|
||
|
|
var
|
||
|
|
i, j, k, itemp, NoTies, NoTieGroups, NoSelected : integer;
|
||
|
|
col1, col2, NCases : integer;
|
||
|
|
index : IntDyneMat;
|
||
|
|
Probability, sumsqrx, sumsqry, Temp, TieSum, Avg, t, SumT, r : double;
|
||
|
|
z, sumdsqr, df : double;
|
||
|
|
Ranks, X : DblDyneMat;
|
||
|
|
d : DblDyneVec;
|
||
|
|
cellstring, outline : string;
|
||
|
|
ColNoSelected : IntDyneVec;
|
||
|
|
ColLabels : StrDyneVec;
|
||
|
|
VarX, VarY, SDX, SDY, MeanX, MeanY, Rxy : double;
|
||
|
|
begin
|
||
|
|
// Allocate memory
|
||
|
|
SetLength(ColNoSelected,NoVariables);
|
||
|
|
SetLength(index,NoCases,2);
|
||
|
|
SetLength(Ranks,NoCases,2);
|
||
|
|
SetLength(X,NoCases,2);
|
||
|
|
SetLength(d,NoCases);
|
||
|
|
SetLength(ColLabels,NoVariables);
|
||
|
|
|
||
|
|
// Get column numbers and labels of variables selected
|
||
|
|
for j := 1 to NoVariables do
|
||
|
|
begin
|
||
|
|
cellstring := OS3MainFrm.DataGrid.Cells[j,0];
|
||
|
|
if cellstring = Xedit.Text then
|
||
|
|
begin
|
||
|
|
ColNoSelected[0] := j;
|
||
|
|
ColLabels[0] := cellstring;
|
||
|
|
end;
|
||
|
|
if cellstring = Yedit.Text then
|
||
|
|
begin
|
||
|
|
ColNoSelected[1] := j;
|
||
|
|
ColLabels[1] := cellstring;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
NoSelected := 2;
|
||
|
|
|
||
|
|
OutPutFrm.RichEdit.Clear;
|
||
|
|
outline := 'Spearman Rank Correlation Between ';
|
||
|
|
outline := outline + ColLabels[0];
|
||
|
|
outline := outline +' & ';
|
||
|
|
outline := outline + ColLabels[1];
|
||
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
||
|
|
OutPutFrm.RichEdit.Lines.Add('');
|
||
|
|
|
||
|
|
// Get scores
|
||
|
|
NCases := 0;
|
||
|
|
MeanX := 0.0;
|
||
|
|
MeanY := 0.0;
|
||
|
|
VarX := 0.0;
|
||
|
|
VarY := 0.0;
|
||
|
|
Rxy := 0.0;
|
||
|
|
NoTies := 0;
|
||
|
|
|
||
|
|
for i := 1 to NoCases do
|
||
|
|
begin
|
||
|
|
if ( not GoodRecord(i,NoSelected,ColNoSelected)) then continue;
|
||
|
|
NCases := NCases + 1;
|
||
|
|
col1 := ColNoSelected[0];
|
||
|
|
col2 := ColNoSelected[1];
|
||
|
|
X[NCases-1,0] := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col1,i]));
|
||
|
|
Ranks[NCases-1,0] := X[NCases-1,0];
|
||
|
|
X[NCases-1,1] := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col2,i]));
|
||
|
|
Ranks[NCases-1,1] := X[NCases-1,1];
|
||
|
|
index[NCases-1,0] := NCases;
|
||
|
|
index[NCases-1,1] := NCases;
|
||
|
|
VarX := VarX + X[NCases-1,0] * X[NCases-1,0];
|
||
|
|
VarY := VarY + X[NCases-1,1] * X[NCases-1,1];
|
||
|
|
MeanX := MeanX + X[NCases-1,0];
|
||
|
|
MeanY := MeanY + X[NCases-1,1];
|
||
|
|
Rxy := Rxy + X[NCases-1,0] * X[NCases-1,1];
|
||
|
|
end;
|
||
|
|
|
||
|
|
// Rank the first variable
|
||
|
|
for i := 1 to NCases - 1 do
|
||
|
|
begin
|
||
|
|
for j := i + 1 to NCases do
|
||
|
|
begin
|
||
|
|
if (Ranks[i-1,0] > Ranks[j-1,0]) then // swap
|
||
|
|
begin
|
||
|
|
Temp := Ranks[i-1,0];
|
||
|
|
Ranks[i-1,0] := Ranks[j-1,0];
|
||
|
|
Ranks[j-1,0] := Temp;
|
||
|
|
itemp := index[i-1,0];
|
||
|
|
index[i-1,0] := index[j-1,0];
|
||
|
|
index[j-1,0] := itemp;
|
||
|
|
Temp := X[i-1,0];
|
||
|
|
X[i-1,0] := X[j-1,0];
|
||
|
|
X[j-1,0] := Temp;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
// Assign ranks
|
||
|
|
for i := 1 to NCases do Ranks[i-1,0] := i;
|
||
|
|
|
||
|
|
// Check for ties in each
|
||
|
|
// NoTieGroups := 0;
|
||
|
|
SumT := 0.0;
|
||
|
|
i := 1;
|
||
|
|
while (i < NCases) do
|
||
|
|
begin
|
||
|
|
j := i+1;
|
||
|
|
TieSum := 0.0;
|
||
|
|
NoTies := 0;
|
||
|
|
while (j <= NCases) do
|
||
|
|
begin
|
||
|
|
if (X[j-1,0] > X[i-1,0]) then goto Check1;
|
||
|
|
if (X[j-1,0] = X[i-1,0]) then
|
||
|
|
begin
|
||
|
|
TieSum := TieSum + 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) / 12.0;
|
||
|
|
SumT := SumT + t;
|
||
|
|
// NoTieGroups := NoTieGroups + 1;
|
||
|
|
i := i + (NoTies-1);
|
||
|
|
end;
|
||
|
|
i := i + 1;
|
||
|
|
end;
|
||
|
|
sumsqrx := ( (Power(NCases,3) - NCases) / 12.0) - SumT;
|
||
|
|
outline := format('Tied ranks correction for X = %8.2f for %d ties',[sumsqrx,NoTies]);
|
||
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
||
|
|
|
||
|
|
// Repeat sort for second variable
|
||
|
|
for i := 1 to NCases - 1 do
|
||
|
|
begin
|
||
|
|
for j := i + 1 to NCases do
|
||
|
|
begin
|
||
|
|
if (Ranks[i-1,1] > Ranks[j-1,1]) then // swap
|
||
|
|
begin
|
||
|
|
Temp := Ranks[i-1,1];
|
||
|
|
Ranks[i-1,1] := Ranks[j-1,1];
|
||
|
|
Ranks[j-1,1] := Temp;
|
||
|
|
itemp := index[i-1,1];
|
||
|
|
index[i-1,1] := index[j-1,1];
|
||
|
|
index[j-1,1] := itemp;
|
||
|
|
Temp := X[i-1,1];
|
||
|
|
X[i-1,1] := X[j-1,1];
|
||
|
|
X[j-1,1] := Temp;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
// Assign ranks
|
||
|
|
for i := 1 to NCases do Ranks[i-1,1] := i;
|
||
|
|
|
||
|
|
// Check for ties in each
|
||
|
|
SumT := 0.0;
|
||
|
|
// NoTieGroups := 0;
|
||
|
|
i := 1;
|
||
|
|
while (i < NCases) do
|
||
|
|
begin
|
||
|
|
j := i+1;
|
||
|
|
TieSum := 0.0;
|
||
|
|
NoTies := 0;
|
||
|
|
while (j <= NCases) do
|
||
|
|
begin
|
||
|
|
if (X[j-1,1] > X[i-1,1]) then goto Check2;
|
||
|
|
if (X[j-1,1] = X[i-1,1]) then
|
||
|
|
begin
|
||
|
|
TieSum := TieSum + Ranks[j-1,1];
|
||
|
|
NoTies := NoTies + 1;
|
||
|
|
end;
|
||
|
|
j := j + 1;
|
||
|
|
end;
|
||
|
|
Check2:
|
||
|
|
if (NoTies > 0) then // at least one tie found
|
||
|
|
begin
|
||
|
|
TieSum := TieSum + Ranks[i-1,1];
|
||
|
|
NoTies := NoTies + 1;
|
||
|
|
Avg := TieSum / NoTies;
|
||
|
|
for j := i to i + NoTies - 1 do Ranks[j-1,1] := Avg;
|
||
|
|
t := ( Power(NoTies,3) - NoTies) / 12.0;
|
||
|
|
SumT := SumT + t;
|
||
|
|
// NoTieGroups := NoTieGroups + 1;
|
||
|
|
i := i + (NoTies-1);
|
||
|
|
end;
|
||
|
|
i := i + 1;
|
||
|
|
end;
|
||
|
|
sumsqry := ( (Power(NCases,3) - NCases) / 12.0) - SumT;
|
||
|
|
outline := format('Tied ranks correction for Y = %8.2f for %d ties',[sumsqry,NoTies]);
|
||
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
||
|
|
|
||
|
|
// arrange scores in order of first variable
|
||
|
|
for i := 1 to Ncases - 1 do
|
||
|
|
begin
|
||
|
|
for j := i + 1 to Ncases do
|
||
|
|
begin
|
||
|
|
if (index[i-1,0] > index[j-1,0]) then // swap all
|
||
|
|
begin
|
||
|
|
itemp := index[i-1,0];
|
||
|
|
index[i-1,0] := index[j-1,0];
|
||
|
|
index[j-1,0] := itemp;
|
||
|
|
Temp := X[i-1,0];
|
||
|
|
X[i-1,0] := X[j-1,0];
|
||
|
|
X[j-1,0] := Temp;
|
||
|
|
Temp := Ranks[i-1,0];
|
||
|
|
Ranks[i-1,0] := Ranks[j-1,0];
|
||
|
|
Ranks[j-1,0] := Temp;
|
||
|
|
end; // end swap
|
||
|
|
end; // next j
|
||
|
|
end; // next i
|
||
|
|
|
||
|
|
// arrange scores of the second variable
|
||
|
|
for i := 1 to Ncases - 1 do
|
||
|
|
begin
|
||
|
|
for j := i + 1 to Ncases do
|
||
|
|
begin
|
||
|
|
if (index[i-1,1] > index[j-1,1]) then // swap all
|
||
|
|
begin
|
||
|
|
itemp := index[i-1,1];
|
||
|
|
index[i-1,1] := index[j-1,1];
|
||
|
|
index[j-1,1] := itemp;
|
||
|
|
Temp := X[i-1,1];
|
||
|
|
X[i-1,1] := X[j-1,1];
|
||
|
|
X[j-1,1] := Temp;
|
||
|
|
Temp := Ranks[i-1,1];
|
||
|
|
Ranks[i-1,1] := Ranks[j-1,1];
|
||
|
|
Ranks[j-1,1] := Temp;
|
||
|
|
end; // end swap
|
||
|
|
end; // next j
|
||
|
|
end; // next i
|
||
|
|
|
||
|
|
// Calculate difference scores
|
||
|
|
sumdsqr := 0.0;
|
||
|
|
for i := 1 to NCases do
|
||
|
|
begin
|
||
|
|
d[i-1] := Ranks[i-1,0] - Ranks[i-1,1];
|
||
|
|
sumdsqr := sumdsqr + (d[i-1] * d[i-1]);
|
||
|
|
end;
|
||
|
|
|
||
|
|
// Calculate corrected spearman rank correlation
|
||
|
|
r := (sumsqrx + sumsqry - sumdsqr) / (2.0 * sqrt(sumsqrx * sumsqry));
|
||
|
|
|
||
|
|
// Calculate Pearson correlation
|
||
|
|
VarX := VarX - (MeanX * MeanX) / NCases;
|
||
|
|
VarX := VarX / (NCases-1);
|
||
|
|
VarY := VarY - (MeanY * MeanY) / NCases;
|
||
|
|
VarY := VarY / (NCases - 1);
|
||
|
|
SDX := sqrt(VarX);
|
||
|
|
SDY := sqrt(VarY);
|
||
|
|
Rxy := Rxy - (MeanX * MeanY) / NCases;
|
||
|
|
Rxy := Rxy / (NCases - 1);
|
||
|
|
Rxy := Rxy / (SDX * SDY);
|
||
|
|
MeanX := MeanX / NCases;
|
||
|
|
MeanY := MeanY / NCases;
|
||
|
|
|
||
|
|
// Output the results
|
||
|
|
OutPutFrm.RichEdit.Lines.Add('');
|
||
|
|
OutPutFrm.RichEdit.Lines.Add('Observed scores, their ranks and differences between ranks');
|
||
|
|
outline := format('CASE %10s Ranks %10s Ranks Rank Difference',
|
||
|
|
[ColLabels[0], ColLabels[1]]);
|
||
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
||
|
|
for i := 1 to NCases do
|
||
|
|
begin
|
||
|
|
outline := format('%4d %10.2f%10.2f%10.2f%10.2f%10.2f',
|
||
|
|
[i, X[i-1,0], Ranks[i-1,0], X[i-1,1], Ranks[i-1,1], d[i-1]]);
|
||
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
||
|
|
end;
|
||
|
|
outline := format('Spearman Rank Correlation = %6.3f',[r]);
|
||
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
||
|
|
OutPutFrm.RichEdit.Lines.Add('');
|
||
|
|
|
||
|
|
if (NCases > 10) then// Use normal distribution approximation
|
||
|
|
begin
|
||
|
|
z := r * sqrt((NCases - 2) / (1.0 - (r * r)));
|
||
|
|
outline := format('t-test value for hypothesis r = 0 is %5.3f',[z]);
|
||
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
||
|
|
df := NCases - 2;
|
||
|
|
Probability := probt(z,df);
|
||
|
|
outline := format('Probability > t = %6.4f',[Probability]);
|
||
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
outline := 'Use table P, page 284 in Siegel for testing significance of r.';
|
||
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
||
|
|
end;
|
||
|
|
|
||
|
|
OutPutFrm.RichEdit.Lines.Add('');
|
||
|
|
outline := format('Pearson r for original scores := %6.3f',[Rxy]);
|
||
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
||
|
|
OutPutFrm.RichEdit.Lines.Add('For the Original Scores:');
|
||
|
|
OutPutFrm.RichEdit.Lines.Add('Mean X Variance X Std.Dev. X Mean Y Variance Y Std.Dev. Y');
|
||
|
|
outline := format('%8.2f %8.2f %8.2f %8.2f %8.2f %8.2f',[MeanX,VarX,SDX,MeanY,VarY,SDY]);
|
||
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
||
|
|
|
||
|
|
OutPutFrm.ShowModal;
|
||
|
|
OutPutFrm.RichEdit.Clear;
|
||
|
|
|
||
|
|
// clean up the heap
|
||
|
|
ColLabels := nil;
|
||
|
|
d := nil;
|
||
|
|
X := nil;
|
||
|
|
Ranks := nil;
|
||
|
|
index := nil;
|
||
|
|
ColNoSelected := nil;
|
||
|
|
end;
|
||
|
|
|
||
|
|
initialization
|
||
|
|
{$I spearmanunit.lrs}
|
||
|
|
|
||
|
|
end.
|
||
|
|
|