You've already forked lazarus-ccr
b0c06dc9c5
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7834 8e941d3f-bd1b-0410-a28a-d453659cc2b4
488 lines
12 KiB
ObjectPascal
488 lines
12 KiB
ObjectPascal
unit SpearmanUnit;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
|
|
StdCtrls, Buttons, ExtCtrls,
|
|
MainUnit, Globals, DataProcs, BasicStatsReportFormUnit;
|
|
|
|
type
|
|
|
|
{ TSpearmanForm }
|
|
|
|
TSpearmanForm = class(TBasicStatsReportForm)
|
|
Bevel1: TBevel;
|
|
XIn: TBitBtn;
|
|
XOut: TBitBtn;
|
|
YIn: TBitBtn;
|
|
YOut: TBitBtn;
|
|
XEdit: TEdit;
|
|
YEdit: TEdit;
|
|
Label1: TLabel;
|
|
Label2: TLabel;
|
|
Label3: TLabel;
|
|
VarList: TListBox;
|
|
procedure VarListDblClick(Sender: TObject);
|
|
procedure VarListSelectionChange(Sender: TObject; {%H-}User: boolean);
|
|
procedure XInClick(Sender: TObject);
|
|
procedure XOutClick(Sender: TObject);
|
|
procedure YInClick(Sender: TObject);
|
|
procedure YOutClick(Sender: TObject);
|
|
|
|
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
|
|
SpearmanForm: TSpearmanForm;
|
|
|
|
|
|
implementation
|
|
|
|
{$R *.lfm}
|
|
|
|
uses
|
|
Math, MathUnit;
|
|
|
|
{ TSpearmanForm }
|
|
|
|
procedure TSpearmanForm.AdjustConstraints;
|
|
begin
|
|
inherited;
|
|
|
|
ParamsPanel.Constraints.MinWidth := 4*CloseBtn.Width + 3*CloseBtn.BorderSpacing.Left;
|
|
ParamsPanel.Constraints.MinHeight := YOut.Top + YOut.Height +
|
|
VarList.BorderSpacing.Bottom + ButtonBevel.Height +
|
|
CloseBtn.BorderSpacing.Top + CloseBtn.Height;
|
|
end;
|
|
|
|
|
|
procedure TSpearmanForm.Compute;
|
|
var
|
|
index: IntDyneMat = nil;
|
|
Ranks: DblDyneMat = nil;
|
|
X: DblDyneMat = nil;
|
|
d: DblDyneVec = nil;
|
|
ColNoSelected: IntDyneVec = nil;
|
|
ColLabels: StrDyneVec = nil;
|
|
i, j, itemp, NoTies, NoSelected: integer;
|
|
col1, col2, NCases: integer;
|
|
Probability, sumsqrx, sumsqry, Temp, TieSum, Avg, t, SumT, r: double;
|
|
z, sumdsqr, df: double;
|
|
cellstring: string;
|
|
VarX, VarY, SDX, SDY, MeanX, MeanY, Rxy: double;
|
|
lReport: TStrings;
|
|
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;
|
|
|
|
lReport := TStringList.Create;
|
|
try
|
|
lReport.Add('SPEARMAN RANK CORRELATION BETWEEN %s AND %s', [ColLabels[0], ColLabels[1]]);;
|
|
lReport.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
|
|
Break;
|
|
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;
|
|
|
|
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;
|
|
lReport.Add('Tied ranks correction for X = %8.2f for %d ties', [sumsqrx, NoTies]);
|
|
|
|
// 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
|
|
Break;
|
|
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;
|
|
|
|
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;
|
|
lReport.Add('Tied ranks correction for Y = %8.2f for %d ties', [sumsqry, NoTies]);
|
|
|
|
// 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
|
|
lReport.Add('');
|
|
lReport.Add('Observed scores, their ranks and differences between ranks');
|
|
lReport.Add('CASE %10s Ranks %10s Ranks Rank Difference', [ColLabels[0], ColLabels[1]]);
|
|
for i := 1 to NCases do
|
|
lReport.Add('%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]]);
|
|
lReport.Add('Spearman Rank Correlation: %6.3f',[r]);
|
|
lReport.Add('');
|
|
|
|
if (NCases > 10) then// Use normal distribution approximation
|
|
begin
|
|
z := r * sqrt((NCases - 2) / (1.0 - (r * r)));
|
|
lReport.Add('t-test value for hypothesis r = 0 is %.3f', [z]);
|
|
df := NCases - 2;
|
|
Probability := ProbT(z,df);
|
|
lReport.Add('Probability > t: %6.4f', [Probability]);
|
|
end
|
|
else
|
|
lReport.Add('Use table P, page 284 in Siegel for testing significance of r.');
|
|
|
|
lReport.Add('');
|
|
lReport.Add('Pearson r for original scores: %.3f', [Rxy]);
|
|
lReport.Add('For the Original Scores:');
|
|
lReport.Add('Mean X Variance X Std.Dev. X Mean Y Variance Y Std.Dev. Y');
|
|
lReport.Add('%8.2f %8.2f %8.2f %8.2f %8.2f %8.2f', [MeanX, VarX, SDX, MeanY, VarY, SDY]);
|
|
|
|
FReportFrame.DisplayReport(lReport);
|
|
|
|
finally
|
|
lReport.Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TSpearmanForm.Reset;
|
|
var
|
|
i: integer;
|
|
begin
|
|
inherited;
|
|
|
|
XEdit.Text := '';
|
|
YEdit.Text := '';
|
|
VarList.Items.Clear;
|
|
for i := 1 to NoVariables do
|
|
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
|
|
|
|
UpdateBtnStates;
|
|
end;
|
|
|
|
|
|
procedure TSpearmanForm.UpdateBtnStates;
|
|
begin
|
|
inherited;
|
|
|
|
XIn.Enabled := (VarList.Count > 0) and (XEdit.Text = '');
|
|
YIn.Enabled := (Varlist.Count > 0) and (YEdit.Text = '');
|
|
XOut.Enabled := XEdit.Text <> '';
|
|
YOut.Enabled := YEdit.Text <> '';
|
|
end;
|
|
|
|
|
|
function TSpearmanForm.Validate(out AMsg: String; out AControl: TWinControl): boolean;
|
|
begin
|
|
Result := false;
|
|
|
|
if (XEdit.Text = '') then begin
|
|
AMsg := 'X variable is not selected.';
|
|
AControl := XEdit;
|
|
exit;
|
|
end;
|
|
|
|
if (YEdit.Text = '') then begin
|
|
AMsg := 'Y variable is not selected.';
|
|
AControl := YEdit;
|
|
exit;
|
|
end;
|
|
|
|
Result := true;
|
|
end;
|
|
|
|
|
|
procedure TSpearmanForm.VarListSelectionChange(Sender: TObject; User: boolean);
|
|
begin
|
|
UpdateBtnStates;
|
|
end;
|
|
|
|
|
|
procedure TSpearmanForm.VarListDblClick(Sender: TObject);
|
|
var
|
|
index: Integer;
|
|
s: String;
|
|
begin
|
|
index := VarList.ItemIndex;
|
|
if index > -1 then
|
|
begin
|
|
s := VarList.Items[index];
|
|
if XEdit.Text = '' then
|
|
XEdit.Text := s
|
|
else if YEdit.Text = '' then
|
|
YEdit.Text := s;
|
|
VarList.Items.Delete(index);
|
|
UpdateBtnStates;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TSpearmanForm.XInClick(Sender: TObject);
|
|
var
|
|
index: integer;
|
|
begin
|
|
index := VarList.ItemIndex;
|
|
if (index > -1) and (XEdit.Text = '') then
|
|
begin
|
|
XEdit.Text := VarList.Items[index];
|
|
VarList.Items.Delete(index);
|
|
end;
|
|
UpdateBtnStates;
|
|
end;
|
|
|
|
|
|
procedure TSpearmanForm.XOutClick(Sender: TObject);
|
|
begin
|
|
if XEdit.Text <> '' then
|
|
begin
|
|
VarList.Items.Add(XEdit.Text);
|
|
XEdit.Text := '';
|
|
end;
|
|
UpdateBtnStates;
|
|
end;
|
|
|
|
|
|
procedure TSpearmanForm.YInClick(Sender: TObject);
|
|
var
|
|
index: integer;
|
|
begin
|
|
index := VarList.ItemIndex;
|
|
if (index > -1) and (YEdit.Text = '') then
|
|
begin
|
|
YEdit.Text := VarList.Items[index];
|
|
VarList.Items.Delete(index);
|
|
end;
|
|
UpdateBtnStates;
|
|
end;
|
|
|
|
|
|
procedure TSpearmanForm.YOutClick(Sender: TObject);
|
|
begin
|
|
if YEdit.Text <> '' then
|
|
begin
|
|
VarList.Items.Add(YEdit.Text);
|
|
YEdit.Text := '';
|
|
end;
|
|
UpdateBtnStates;
|
|
end;
|
|
|
|
|
|
end.
|
|
|