You've already forked lazarus-ccr
639 lines
18 KiB
ObjectPascal
639 lines
18 KiB
ObjectPascal
|
// Use file "taudata.laz" for testing.
|
||
|
|
|
||
|
|
unit KendallTauUnit;
|
||
|
|
|
||
|
|
{$mode objfpc}{$H+}
|
||
|
|
|
||
|
|
interface
|
||
|
|
|
||
|
|
uses
|
||
|
|
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
||
|
|
StdCtrls, Buttons, ExtCtrls,
|
||
|
|
MainUnit, OutputUnit, FunctionsLib, Globals, DataProcs, MatrixLib;
|
||
|
|
|
||
|
|
type
|
||
|
|
|
||
|
|
{ TKendallTauFrm }
|
||
|
|
|
||
|
|
TKendallTauFrm = class(TForm)
|
||
|
|
Bevel1: TBevel;
|
||
|
|
ResetBtn: TButton;
|
||
|
|
ComputeBtn: TButton;
|
||
|
|
CloseBtn: TButton;
|
||
|
|
RanksChk: TCheckBox;
|
||
|
|
OptionsGroup: TGroupBox;
|
||
|
|
XEdit: TEdit;
|
||
|
|
YEdit: TEdit;
|
||
|
|
ZEdit: TEdit;
|
||
|
|
Label2: TLabel;
|
||
|
|
Label3: TLabel;
|
||
|
|
Label4: TLabel;
|
||
|
|
XIn: TBitBtn;
|
||
|
|
XOut: TBitBtn;
|
||
|
|
YIn: TBitBtn;
|
||
|
|
YOut: TBitBtn;
|
||
|
|
ZIn: TBitBtn;
|
||
|
|
ZOut: TBitBtn;
|
||
|
|
Label1: TLabel;
|
||
|
|
VarList: TListBox;
|
||
|
|
procedure ComputeBtnClick(Sender: TObject);
|
||
|
|
procedure FormActivate(Sender: TObject);
|
||
|
|
procedure FormCreate(Sender: TObject);
|
||
|
|
procedure FormShow(Sender: TObject);
|
||
|
|
procedure ResetBtnClick(Sender: TObject);
|
||
|
|
procedure VarListSelectionChange(Sender: TObject; User: boolean);
|
||
|
|
procedure XInClick(Sender: TObject);
|
||
|
|
procedure XOutClick(Sender: TObject);
|
||
|
|
procedure YInClick(Sender: TObject);
|
||
|
|
procedure YOutClick(Sender: TObject);
|
||
|
|
procedure ZInClick(Sender: TObject);
|
||
|
|
procedure ZOutClick(Sender: TObject);
|
||
|
|
private
|
||
|
|
{ private declarations }
|
||
|
|
FAutoSized: Boolean;
|
||
|
|
procedure UpdateBtnStates;
|
||
|
|
public
|
||
|
|
{ public declarations }
|
||
|
|
end;
|
||
|
|
|
||
|
|
var
|
||
|
|
KendallTauFrm: TKendallTauFrm;
|
||
|
|
|
||
|
|
implementation
|
||
|
|
|
||
|
|
uses
|
||
|
|
Math;
|
||
|
|
|
||
|
|
{ TKendallTauFrm }
|
||
|
|
|
||
|
|
procedure TKendallTauFrm.ResetBtnClick(Sender: TObject);
|
||
|
|
var
|
||
|
|
i: integer;
|
||
|
|
begin
|
||
|
|
XEdit.Text := '';
|
||
|
|
YEdit.Text := '';
|
||
|
|
ZEdit.Text := '';
|
||
|
|
RanksChk.Checked := false;
|
||
|
|
VarList.Items.Clear;
|
||
|
|
for i := 1 to NoVariables do
|
||
|
|
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
|
||
|
|
UpdateBtnStates;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TKendallTauFrm.VarListSelectionChange(Sender: TObject; User: boolean);
|
||
|
|
begin
|
||
|
|
UpdateBtnStates;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TKendallTauFrm.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 TKendallTauFrm.XOutClick(Sender: TObject);
|
||
|
|
begin
|
||
|
|
if XEdit.Text <> '' then
|
||
|
|
begin
|
||
|
|
VarList.Items.Add(XEdit.Text);
|
||
|
|
XEdit.Text := '';
|
||
|
|
end;
|
||
|
|
UpdateBtnStates;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TKendallTauFrm.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 TKendallTauFrm.YOutClick(Sender: TObject);
|
||
|
|
begin
|
||
|
|
if YEdit.Text <> '' then
|
||
|
|
begin
|
||
|
|
VarList.Items.Add(YEdit.Text);
|
||
|
|
YEdit.Text := '';
|
||
|
|
end;
|
||
|
|
UpdateBtnStates;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TKendallTauFrm.ZInClick(Sender: TObject);
|
||
|
|
var
|
||
|
|
index: integer;
|
||
|
|
begin
|
||
|
|
index := VarList.ItemIndex;
|
||
|
|
if (index > -1) and (ZEdit.Text = '') then
|
||
|
|
begin
|
||
|
|
ZEdit.Text := VarList.Items[index];
|
||
|
|
VarList.Items.Delete(index);
|
||
|
|
end;
|
||
|
|
UpdateBtnStates;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TKendallTauFrm.ZOutClick(Sender: TObject);
|
||
|
|
begin
|
||
|
|
if ZEdit.Text <> '' then
|
||
|
|
begin
|
||
|
|
VarList.Items.Add(YEdit.Text);
|
||
|
|
ZEdit.Text := '';
|
||
|
|
end;
|
||
|
|
UpdateBtnStates;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TKendallTauFrm.FormActivate(Sender: TObject);
|
||
|
|
var
|
||
|
|
w: Integer;
|
||
|
|
begin
|
||
|
|
if FAutoSized then
|
||
|
|
exit;
|
||
|
|
|
||
|
|
w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]);
|
||
|
|
ResetBtn.Constraints.MinWidth := w;
|
||
|
|
ComputeBtn.Constraints.MinWidth := w;
|
||
|
|
CloseBtn.Constraints.MinWidth := w;
|
||
|
|
VarList.Constraints.MinHeight := OptionsGroup.Top + OptionsGroup.Height - VarList.Top;
|
||
|
|
|
||
|
|
Constraints.MinWidth := OptionsGroup.Width * 2 + XIn.Width + 4 * VarList.BorderSpacing.Left;
|
||
|
|
Constraints.MinHeight := Height;
|
||
|
|
|
||
|
|
FAutoSized := True;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TKendallTauFrm.FormCreate(Sender: TObject);
|
||
|
|
begin
|
||
|
|
Assert(OS3MainFrm <> nil);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TKendallTauFrm.FormShow(Sender: TObject);
|
||
|
|
begin
|
||
|
|
ResetBtnClick(self);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TKendallTauFrm.ComputeBtnClick(Sender: TObject);
|
||
|
|
var
|
||
|
|
i, j, k, itemp, NoTies, NoSelected : integer;
|
||
|
|
col1, col2, col3, NCases : integer;
|
||
|
|
index : IntDyneMat;
|
||
|
|
Probability, Temp, TieSum, Avg, SumT: double;
|
||
|
|
z, denominator, stddev : double;
|
||
|
|
Ranks, X : DblDyneMat;
|
||
|
|
cellstring: string;
|
||
|
|
ColNoSelected : IntdyneVec;
|
||
|
|
ColLabels : StrDyneVec;
|
||
|
|
RowLabels : StrDyneVec;
|
||
|
|
TauXY, TauXZ, TauYZ : double;
|
||
|
|
Tx, Ty, Tz : double;
|
||
|
|
Term1, Term2 : double;
|
||
|
|
PartialTau : double;
|
||
|
|
title : string;
|
||
|
|
lReport: TStrings;
|
||
|
|
begin
|
||
|
|
if XEdit.Text = '' then
|
||
|
|
begin
|
||
|
|
MessageDlg('X variable not selected.', mtError, [mbOK], 0);
|
||
|
|
exit;
|
||
|
|
end;
|
||
|
|
if YEdit.Text = '' then
|
||
|
|
begin
|
||
|
|
MessageDlg('Y variable not selected.', mtError, [mbOK], 0);
|
||
|
|
exit;
|
||
|
|
end;
|
||
|
|
|
||
|
|
// Allocate memory
|
||
|
|
SetLength(index,NoCases,3);
|
||
|
|
SetLength(Ranks,NoCases,3);
|
||
|
|
SetLength(X,NoCases,3);
|
||
|
|
SetLength(ColLabels,3);
|
||
|
|
SetLength(RowLabels,NoCases);
|
||
|
|
SetLength(ColNoSelected,NoVariables);
|
||
|
|
Tx := 0.0;
|
||
|
|
Ty := 0.0;
|
||
|
|
Tz := 0.0;
|
||
|
|
|
||
|
|
// Get column numbers and labels of variables selected
|
||
|
|
NoSelected := 0;
|
||
|
|
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;
|
||
|
|
NoSelected := NoSelected + 1;
|
||
|
|
end;
|
||
|
|
if cellstring = Yedit.Text then
|
||
|
|
begin
|
||
|
|
ColNoSelected[1] := j;
|
||
|
|
ColLabels[1] := cellstring;
|
||
|
|
NoSelected := NoSelected + 1;
|
||
|
|
end;
|
||
|
|
if cellstring = Zedit.Text then
|
||
|
|
begin
|
||
|
|
ColNoSelected[2] := j;
|
||
|
|
ColLabels[2] := cellstring;
|
||
|
|
NoSelected := NoSelected + 1;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
// Get scores
|
||
|
|
NCases := 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];
|
||
|
|
if NoSelected = 3 then col3 := ColNoSelected[2];
|
||
|
|
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];
|
||
|
|
if NoSelected = 3 then
|
||
|
|
begin
|
||
|
|
X[NCases-1,2] := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col3,i]));
|
||
|
|
Ranks[NCases-1,2] := X[NCases-1,2];
|
||
|
|
end;
|
||
|
|
index[NCases-1,0] := NCases;
|
||
|
|
index[NCases-1,1] := NCases;
|
||
|
|
if NoSelected = 3 then index[NCases-1,2] := NCases;
|
||
|
|
end;
|
||
|
|
|
||
|
|
for i := 0 to NCases - 1 do RowLabels[i] := IntToStr(i+1);
|
||
|
|
// Rank the first variable (X)
|
||
|
|
for i := 0 to NCases - 2 do
|
||
|
|
begin
|
||
|
|
for j := i + 1 to NCases-1 do
|
||
|
|
begin
|
||
|
|
if (Ranks[i,0] > Ranks[j,0]) then // swap
|
||
|
|
begin
|
||
|
|
Temp := Ranks[i,0];
|
||
|
|
Ranks[i,0] := Ranks[j,0];
|
||
|
|
Ranks[j,0] := Temp;
|
||
|
|
itemp := index[i,0];
|
||
|
|
index[i,0] := index[j,0];
|
||
|
|
index[j,0] := itemp;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
// Assign ranks
|
||
|
|
for i := 0 to NCases-1 do Ranks[i,0] := i+1;
|
||
|
|
|
||
|
|
// Check for ties in each
|
||
|
|
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;
|
||
|
|
i := i + (NoTies-1);
|
||
|
|
Tx := Tx + NoTies *(NoTies-1);
|
||
|
|
end;
|
||
|
|
i := i + 1;
|
||
|
|
end;
|
||
|
|
Tx := Tx / 2.0;
|
||
|
|
|
||
|
|
// Repeat sort for second variable Y
|
||
|
|
for i := 0 to NCases - 2 do
|
||
|
|
begin
|
||
|
|
for j := i + 1 to NCases-1 do
|
||
|
|
begin
|
||
|
|
if (Ranks[i,1] > Ranks[j,1]) then // swap
|
||
|
|
begin
|
||
|
|
Temp := Ranks[i,1];
|
||
|
|
Ranks[i,1] := Ranks[j,1];
|
||
|
|
Ranks[j,1] := Temp;
|
||
|
|
itemp := index[i,1];
|
||
|
|
index[i,1] := index[j,1];
|
||
|
|
index[j,1] := itemp;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
// Assign ranks
|
||
|
|
for i := 0 to NCases-1 do Ranks[i,1] := i+1;
|
||
|
|
|
||
|
|
// Check for ties in each
|
||
|
|
i := 1;
|
||
|
|
while (i < NCases) do
|
||
|
|
begin
|
||
|
|
j := i+1;
|
||
|
|
TieSum := 0.0;
|
||
|
|
NoTies := 0;
|
||
|
|
while (j <= NoCases) 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;
|
||
|
|
i := i + (NoTies-1);
|
||
|
|
Ty := Ty + NoTies * (NoTies - 1);
|
||
|
|
end;
|
||
|
|
i := i + 1;
|
||
|
|
end;
|
||
|
|
Ty := Ty / 2.0;
|
||
|
|
|
||
|
|
// Repeat for z variable
|
||
|
|
if NoSelected > 2 then // z was entered
|
||
|
|
begin
|
||
|
|
for i := 0 to NCases - 2 do
|
||
|
|
begin
|
||
|
|
for j := i + 1 to NCases-1 do
|
||
|
|
begin
|
||
|
|
if (Ranks[i,2] > Ranks[j,2]) then // swap
|
||
|
|
begin
|
||
|
|
Temp := Ranks[i,2];
|
||
|
|
Ranks[i,2] := Ranks[j,2];
|
||
|
|
Ranks[j,2] := Temp;
|
||
|
|
itemp := index[i,2];
|
||
|
|
index[i,2] := index[j,2];
|
||
|
|
index[j,2] := itemp;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
// Assign ranks
|
||
|
|
for i := 0 to NCases-1 do Ranks[i,2] := i+1;
|
||
|
|
|
||
|
|
// Check for ties in each
|
||
|
|
i := 1;
|
||
|
|
while (i < NCases) do
|
||
|
|
begin
|
||
|
|
j := i+1;
|
||
|
|
TieSum := 0.0;
|
||
|
|
NoTies := 0;
|
||
|
|
while (j <= NoCases) do
|
||
|
|
begin
|
||
|
|
if (X[j-1,2] > X[i-1,2]) then
|
||
|
|
Break;
|
||
|
|
if (X[j-1,2] = X[i-1,2]) then
|
||
|
|
begin
|
||
|
|
TieSum := TieSum + Ranks[j-1,2];
|
||
|
|
NoTies := NoTies + 1;
|
||
|
|
end;
|
||
|
|
j := j + 1;
|
||
|
|
end;
|
||
|
|
|
||
|
|
if (NoTies > 0) then // at least one tie found
|
||
|
|
begin
|
||
|
|
TieSum := TieSum + Ranks[i-1,2];
|
||
|
|
NoTies := NoTies + 1;
|
||
|
|
Avg := TieSum / NoTies;
|
||
|
|
for j := i to i + NoTies - 1 do Ranks[j-1,2] := Avg;
|
||
|
|
i := i + (NoTies-1);
|
||
|
|
Tz := Tz + NoTies * (NoTies - 1);
|
||
|
|
end;
|
||
|
|
i := i + 1;
|
||
|
|
end;
|
||
|
|
Tz := Tz / 2.0;
|
||
|
|
end;
|
||
|
|
|
||
|
|
// Rearrange ranks into original score order
|
||
|
|
for k := 1 to 3 do
|
||
|
|
begin
|
||
|
|
for i := 1 to NCases - 1 do
|
||
|
|
begin
|
||
|
|
for j := i + 1 to NCases do
|
||
|
|
begin
|
||
|
|
if (index[i-1,k-1] > index[j-1,k-1]) then // swap
|
||
|
|
begin
|
||
|
|
itemp := index[i-1,k-1];
|
||
|
|
index[i-1,k-1] := index[j-1,k-1];
|
||
|
|
index[j-1,k-1] := itemp;
|
||
|
|
Temp := Ranks[i-1,k-1];
|
||
|
|
Ranks[i-1,k-1] := Ranks[j-1,k-1];
|
||
|
|
Ranks[j-1,k-1] := Temp;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
// compute Tau for X and Y
|
||
|
|
// sort on X and obtain SumT for Y ranks
|
||
|
|
SumT := 0.0;
|
||
|
|
for i := 0 to NCases - 2 do
|
||
|
|
begin
|
||
|
|
for j := i + 1 to NCases-1 do
|
||
|
|
begin
|
||
|
|
if (Ranks[i,0] > Ranks[j,0]) then // swap
|
||
|
|
begin
|
||
|
|
Temp := Ranks[i,0];
|
||
|
|
Ranks[i,0] := Ranks[j,0];
|
||
|
|
Ranks[j,0] := Temp;
|
||
|
|
Temp := Ranks[i,1];
|
||
|
|
Ranks[i,1] := Ranks[j,1];
|
||
|
|
Ranks[j,1] := Temp;
|
||
|
|
if NoSelected = 3 then
|
||
|
|
begin
|
||
|
|
Temp := Ranks[i,2];
|
||
|
|
Ranks[i,2] := Ranks[j,2];
|
||
|
|
Ranks[j,2] := Temp;
|
||
|
|
end;
|
||
|
|
itemp := index[i,0];
|
||
|
|
index[i,0] := index[j,0];
|
||
|
|
index[j,0] := itemp;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
for i := 0 to NCases - 2 do
|
||
|
|
for j := i + 1 to NCases - 1 do
|
||
|
|
if Ranks[i,1] < Ranks[j,1] then SumT := SumT + 1.0
|
||
|
|
else if Ranks[i,1] > Ranks[j,1] then SumT := SumT - 1.0;
|
||
|
|
Term1 := sqrt((NCases * (NCases-1)) / 2.0 - Tx);
|
||
|
|
Term2 := sqrt((NCases * (Ncases-1)) / 2.0 - Ty);
|
||
|
|
denominator := Term1 * Term2;
|
||
|
|
TauXY := SumT / denominator;
|
||
|
|
|
||
|
|
if NoSelected > 2 then // get tau values for partial
|
||
|
|
begin
|
||
|
|
// Get TauXZ
|
||
|
|
SumT := 0.0;
|
||
|
|
for i := 0 to NCases - 2 do
|
||
|
|
for j := i + 1 to NCases - 1 do
|
||
|
|
if Ranks[i,2] < Ranks[j,2] then SumT := SumT + 1.0
|
||
|
|
else if Ranks[i,2] > Ranks[j,2] then SumT := SumT - 1.0;
|
||
|
|
Term1 := sqrt((NCases * (NCases-1)) / 2.0 - Tx);
|
||
|
|
Term2 := sqrt((NCases * (Ncases-1)) / 2.0 - Tz);
|
||
|
|
denominator := Term1 * Term2;
|
||
|
|
TauXZ := SumT / denominator;
|
||
|
|
|
||
|
|
// get back to original order then sort on Y
|
||
|
|
for i := 0 to NCases - 2 do
|
||
|
|
begin
|
||
|
|
for j := i + 1 to NCases - 1 do
|
||
|
|
begin
|
||
|
|
if index[i,0] > index[j,0] then // swap
|
||
|
|
begin
|
||
|
|
Temp := Ranks[i,0];
|
||
|
|
Ranks[i,0] := Ranks[j,0];
|
||
|
|
Ranks[j,0] := temp;
|
||
|
|
Temp := Ranks[i,1];
|
||
|
|
Ranks[i,1] := Ranks[j,1];
|
||
|
|
Ranks[j,1] := Temp;
|
||
|
|
Temp := Ranks[i,2];
|
||
|
|
Ranks[i,2] := Ranks[j,2];
|
||
|
|
Ranks[j,2] := Temp;
|
||
|
|
itemp := index[i,0];
|
||
|
|
index[i,0] := index[j,0];
|
||
|
|
index[j,0] := itemp;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
// Get TauYZ
|
||
|
|
for i := 0 to NCases - 2 do // sort on Y variable
|
||
|
|
begin
|
||
|
|
for j := i + 1 to NCases-1 do
|
||
|
|
begin
|
||
|
|
if (Ranks[i,1] > Ranks[j,1]) then // swap
|
||
|
|
begin
|
||
|
|
Temp := Ranks[i,1];
|
||
|
|
Ranks[i,1] := Ranks[j,1];
|
||
|
|
Ranks[j,1] := Temp;
|
||
|
|
Temp := Ranks[i,2];
|
||
|
|
Ranks[i,2] := Ranks[j,2];
|
||
|
|
Ranks[j,2] := Temp;
|
||
|
|
itemp := index[i,1];
|
||
|
|
index[i,1] := index[j,1];
|
||
|
|
index[j,1] := itemp;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
SumT := 0.0;
|
||
|
|
for i := 0 to NCases - 2 do
|
||
|
|
for j := i + 1 to NCases - 1 do
|
||
|
|
if Ranks[i,2] < Ranks[j,2] then SumT := SumT + 1.0
|
||
|
|
else if Ranks[i,2] > Ranks[j,2] then SumT := SumT - 1.0;
|
||
|
|
Term1 := sqrt((NCases * (NCases-1)) / 2.0 - Ty);
|
||
|
|
Term2 := sqrt((NCases * (Ncases-1)) / 2.0 - Tz);
|
||
|
|
denominator := Term1 * Term2;
|
||
|
|
TauYZ := SumT / denominator;
|
||
|
|
PartialTau := (TauXY - TauXZ * TauYZ) /
|
||
|
|
(sqrt(1.0 - sqr(TauXZ)) * sqrt(1.0 - sqr(TauYZ)));
|
||
|
|
end;
|
||
|
|
|
||
|
|
lReport := TStringList.Create;
|
||
|
|
try
|
||
|
|
lReport.Add('Kendall Tau for File ' + OS3MainFrm.FileNameEdit.Text);
|
||
|
|
lReport.Add('');
|
||
|
|
lReport.Add('Kendall Tau for Variables ' + ColLabels[0] + ' and ' + ColLabels[1]);
|
||
|
|
|
||
|
|
// do significance tests
|
||
|
|
stddev := sqrt( (2.0 * ( 2.0 * NCases + 5)) / (9.0 * NCases * (NCases - 1.0)));
|
||
|
|
z := abs(TauXY / stddev);
|
||
|
|
probability := 1.0 - probz(z);
|
||
|
|
lReport.Add('Tau = %8.4f z = %8.3f probability > |z| = %4.3f', [TauXY, z, probability]);
|
||
|
|
if NoSelected > 2 then
|
||
|
|
begin
|
||
|
|
lReport.Add('');
|
||
|
|
z := abs(TauXZ / stddev);
|
||
|
|
probability := 1.0 - probz(z);
|
||
|
|
lReport.Add('Kendall Tau for variables ' + ColLabels[0] + ' and ' + ColLabels[2]);
|
||
|
|
lReport.Add('Tau = %8.4f z = %8.3f probability > |z| = %4.3f', [TauXZ, z, probability]);
|
||
|
|
z := abs(TauYZ / stddev);
|
||
|
|
probability := 1.0 - probz(z);
|
||
|
|
lReport.Add('');
|
||
|
|
lReport.Add('Kendall Tau for variables ' + ColLabels[1] + ' and ' + ColLabels[2]);
|
||
|
|
lReport.Add('Tau = %8.4f z = %8.3f probability > |z| = %4.3f', [TauYZ, z, probability]);
|
||
|
|
lReport.Add('');
|
||
|
|
lReport.Add('Partial Tau = %8.4f', [PartialTau]);
|
||
|
|
end;
|
||
|
|
lReport.Add('');
|
||
|
|
lReport.Add('NOTE: Probabilities are for large N (>10)');
|
||
|
|
|
||
|
|
// print data matrix if option is elected
|
||
|
|
if RanksChk.Checked then
|
||
|
|
begin
|
||
|
|
lReport.Add('');
|
||
|
|
lReport.Add('-----------------------------------------------------------------');
|
||
|
|
lReport.Add('');
|
||
|
|
title := 'Ranks';
|
||
|
|
if NoSelected = 2 then
|
||
|
|
MatPrint(Ranks, NCases, 2, title, RowLabels, ColLabels, NCases, lReport)
|
||
|
|
else
|
||
|
|
MatPrint(Ranks, NCases, 3, title, RowLabels, ColLabels, NCases, lReport);
|
||
|
|
end;
|
||
|
|
|
||
|
|
DisplayReport(lReport);
|
||
|
|
finally
|
||
|
|
lReport.Free;
|
||
|
|
ColNoSelected := nil;
|
||
|
|
RowLabels := nil;
|
||
|
|
ColLabels := nil;
|
||
|
|
X := nil;
|
||
|
|
Ranks := nil;
|
||
|
|
index := nil;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TKendallTauFrm.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;
|
||
|
|
XIn.Enabled := lSelected and (XEdit.Text = '');
|
||
|
|
YIn.Enabled := lSelected and (YEdit.Text = '');
|
||
|
|
ZIn.Enabled := lSelected and (ZEdit.Text = '');
|
||
|
|
XOut.Enabled := (XEdit.Text <> '');
|
||
|
|
YOut.Enabled := (YEdit.Text <> '');
|
||
|
|
ZOut.Enabled := (ZEdit.Text <> '');
|
||
|
|
end;
|
||
|
|
|
||
|
|
initialization
|
||
|
|
{$I kendalltauunit.lrs}
|
||
|
|
|
||
|
|
end.
|
||
|
|
|