You've already forked lazarus-ccr
LazStats: Refactor GenKappaUnit. Add pdf help to chm. Add files GenKappa.laz and KappaTest3.laz from OpenStat sample files.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7410 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
107
applications/lazstats/data/KappaTest3.laz
Normal file
107
applications/lazstats/data/KappaTest3.laz
Normal file
@ -0,0 +1,107 @@
|
||||
20
|
||||
3
|
||||
Rater
|
||||
VARIABLE 1
|
||||
1
|
||||
I
|
||||
0
|
||||
99999
|
||||
L
|
||||
Object
|
||||
VARIABLE 2
|
||||
1
|
||||
I
|
||||
0
|
||||
99999
|
||||
L
|
||||
Category
|
||||
VARIABLE 3
|
||||
1
|
||||
I
|
||||
0
|
||||
99999
|
||||
L
|
||||
Case 0
|
||||
Rater
|
||||
Object
|
||||
Category
|
||||
Case 1
|
||||
1
|
||||
1
|
||||
1
|
||||
Case 2
|
||||
1
|
||||
1
|
||||
1
|
||||
Case 3
|
||||
1
|
||||
1
|
||||
1
|
||||
Case 4
|
||||
1
|
||||
1
|
||||
1
|
||||
Case 5
|
||||
1
|
||||
1
|
||||
1
|
||||
Case 6
|
||||
1
|
||||
1
|
||||
2
|
||||
Case 7
|
||||
1
|
||||
1
|
||||
2
|
||||
Case 8
|
||||
1
|
||||
1
|
||||
2
|
||||
Case 9
|
||||
1
|
||||
1
|
||||
3
|
||||
Case 10
|
||||
1
|
||||
1
|
||||
3
|
||||
Case 11
|
||||
2
|
||||
1
|
||||
1
|
||||
Case 12
|
||||
2
|
||||
1
|
||||
1
|
||||
Case 13
|
||||
2
|
||||
1
|
||||
1
|
||||
Case 14
|
||||
2
|
||||
1
|
||||
1
|
||||
Case 15
|
||||
2
|
||||
1
|
||||
1
|
||||
Case 16
|
||||
2
|
||||
1
|
||||
1
|
||||
Case 17
|
||||
2
|
||||
1
|
||||
2
|
||||
Case 18
|
||||
2
|
||||
1
|
||||
2
|
||||
Case 19
|
||||
2
|
||||
1
|
||||
2
|
||||
Case 20
|
||||
2
|
||||
1
|
||||
3
|
||||
87
applications/lazstats/data/genkappa.laz
Normal file
87
applications/lazstats/data/genkappa.laz
Normal file
@ -0,0 +1,87 @@
|
||||
15
|
||||
3
|
||||
rater
|
||||
VARIABLE 1
|
||||
1
|
||||
I
|
||||
0
|
||||
99999
|
||||
L
|
||||
object
|
||||
VARIABLE 2
|
||||
1
|
||||
I
|
||||
0
|
||||
99999
|
||||
L
|
||||
category
|
||||
VARIABLE 3
|
||||
1
|
||||
I
|
||||
0
|
||||
99999
|
||||
L
|
||||
Case 0
|
||||
rater
|
||||
object
|
||||
category
|
||||
Case 1
|
||||
1
|
||||
1
|
||||
1
|
||||
Case 2
|
||||
1
|
||||
2
|
||||
2
|
||||
Case 3
|
||||
1
|
||||
3
|
||||
3
|
||||
Case 4
|
||||
1
|
||||
4
|
||||
2
|
||||
Case 5
|
||||
1
|
||||
5
|
||||
3
|
||||
Case 6
|
||||
2
|
||||
1
|
||||
1
|
||||
Case 7
|
||||
2
|
||||
2
|
||||
2
|
||||
Case 8
|
||||
2
|
||||
3
|
||||
2
|
||||
Case 9
|
||||
2
|
||||
4
|
||||
3
|
||||
Case 10
|
||||
2
|
||||
5
|
||||
3
|
||||
Case 11
|
||||
3
|
||||
1
|
||||
1
|
||||
Case 12
|
||||
3
|
||||
2
|
||||
2
|
||||
Case 13
|
||||
3
|
||||
3
|
||||
3
|
||||
Case 14
|
||||
3
|
||||
4
|
||||
2
|
||||
Case 15
|
||||
3
|
||||
5
|
||||
3
|
||||
Binary file not shown.
Binary file not shown.
@ -13,92 +13,74 @@ object GenKappaFrm: TGenKappaFrm
|
||||
Position = poMainFormCenter
|
||||
LCLVersion = '2.1.0.0'
|
||||
object ResetBtn: TButton
|
||||
AnchorSideRight.Control = CancelBtn
|
||||
AnchorSideRight.Control = ComputeBtn
|
||||
AnchorSideBottom.Control = Owner
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 167
|
||||
Left = 259
|
||||
Height = 25
|
||||
Top = 323
|
||||
Width = 54
|
||||
Anchors = [akRight, akBottom]
|
||||
AutoSize = True
|
||||
BorderSpacing.Left = 12
|
||||
BorderSpacing.Left = 8
|
||||
BorderSpacing.Top = 8
|
||||
BorderSpacing.Right = 12
|
||||
BorderSpacing.Right = 8
|
||||
BorderSpacing.Bottom = 8
|
||||
Caption = 'Reset'
|
||||
OnClick = ResetBtnClick
|
||||
TabOrder = 2
|
||||
end
|
||||
object CancelBtn: TButton
|
||||
AnchorSideRight.Control = ComputeBtn
|
||||
AnchorSideBottom.Control = Owner
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 233
|
||||
Height = 25
|
||||
Top = 323
|
||||
Width = 62
|
||||
Anchors = [akRight, akBottom]
|
||||
AutoSize = True
|
||||
BorderSpacing.Left = 12
|
||||
BorderSpacing.Top = 8
|
||||
BorderSpacing.Right = 12
|
||||
BorderSpacing.Bottom = 8
|
||||
Caption = 'Cancel'
|
||||
ModalResult = 2
|
||||
TabOrder = 3
|
||||
end
|
||||
object ComputeBtn: TButton
|
||||
AnchorSideRight.Control = ReturnBtn
|
||||
AnchorSideRight.Control = CloseBtn
|
||||
AnchorSideBottom.Control = Owner
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 307
|
||||
Left = 321
|
||||
Height = 25
|
||||
Top = 323
|
||||
Width = 76
|
||||
Anchors = [akRight, akBottom]
|
||||
AutoSize = True
|
||||
BorderSpacing.Left = 12
|
||||
BorderSpacing.Left = 8
|
||||
BorderSpacing.Top = 8
|
||||
BorderSpacing.Right = 12
|
||||
BorderSpacing.Right = 8
|
||||
BorderSpacing.Bottom = 8
|
||||
Caption = 'Compute'
|
||||
OnClick = ComputeBtnClick
|
||||
TabOrder = 4
|
||||
TabOrder = 3
|
||||
end
|
||||
object ReturnBtn: TButton
|
||||
object CloseBtn: TButton
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = Owner
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 395
|
||||
Left = 405
|
||||
Height = 25
|
||||
Top = 323
|
||||
Width = 61
|
||||
Width = 55
|
||||
Anchors = [akRight, akBottom]
|
||||
AutoSize = True
|
||||
BorderSpacing.Left = 12
|
||||
BorderSpacing.Left = 8
|
||||
BorderSpacing.Top = 8
|
||||
BorderSpacing.Right = 12
|
||||
BorderSpacing.Right = 8
|
||||
BorderSpacing.Bottom = 8
|
||||
Caption = 'Return'
|
||||
ModalResult = 1
|
||||
TabOrder = 5
|
||||
Caption = 'Close'
|
||||
ModalResult = 11
|
||||
TabOrder = 4
|
||||
end
|
||||
object HelpBtn: TButton
|
||||
Tag = 125
|
||||
AnchorSideRight.Control = ResetBtn
|
||||
AnchorSideBottom.Control = Owner
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 104
|
||||
Left = 200
|
||||
Height = 25
|
||||
Top = 323
|
||||
Width = 51
|
||||
Anchors = [akRight, akBottom]
|
||||
AutoSize = True
|
||||
BorderSpacing.Left = 12
|
||||
BorderSpacing.Left = 8
|
||||
BorderSpacing.Top = 8
|
||||
BorderSpacing.Right = 12
|
||||
BorderSpacing.Right = 8
|
||||
BorderSpacing.Bottom = 8
|
||||
Caption = 'Help'
|
||||
OnClick = HelpBtnClick
|
||||
@ -195,6 +177,7 @@ object GenKappaFrm: TGenKappaFrm
|
||||
BorderSpacing.Top = 2
|
||||
BorderSpacing.Right = 8
|
||||
ItemHeight = 0
|
||||
OnSelectionChange = VarListSelectionChange
|
||||
TabOrder = 0
|
||||
end
|
||||
object CatIn: TBitBtn
|
||||
@ -306,6 +289,7 @@ object GenKappaFrm: TGenKappaFrm
|
||||
Anchors = [akLeft, akRight, akBottom]
|
||||
BorderSpacing.Left = 8
|
||||
BorderSpacing.Bottom = 12
|
||||
ReadOnly = True
|
||||
TabOrder = 3
|
||||
Text = 'CatEdit'
|
||||
end
|
||||
@ -323,8 +307,9 @@ object GenKappaFrm: TGenKappaFrm
|
||||
Anchors = [akLeft, akRight, akBottom]
|
||||
BorderSpacing.Left = 8
|
||||
BorderSpacing.Bottom = 12
|
||||
ReadOnly = True
|
||||
TabOrder = 6
|
||||
Text = 'Edit1'
|
||||
Text = 'ObjectEdit'
|
||||
end
|
||||
object RaterEdit: TEdit
|
||||
AnchorSideLeft.Control = RaterOut
|
||||
@ -341,8 +326,9 @@ object GenKappaFrm: TGenKappaFrm
|
||||
Anchors = [akLeft, akRight, akBottom]
|
||||
BorderSpacing.Left = 8
|
||||
BorderSpacing.Bottom = 12
|
||||
ReadOnly = True
|
||||
TabOrder = 9
|
||||
Text = 'Edit1'
|
||||
Text = 'RaterEdit'
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
@ -1,3 +1,7 @@
|
||||
// File for testing according to pdf help: KappaTest3.laz
|
||||
// BUT: Yields different results than pdf
|
||||
// --> using file genkappa.laz for the chm
|
||||
|
||||
unit GenKappaUnit;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
@ -18,9 +22,8 @@ type
|
||||
Label4: TLabel;
|
||||
Panel1: TPanel;
|
||||
ResetBtn: TButton;
|
||||
CancelBtn: TButton;
|
||||
ComputeBtn: TButton;
|
||||
ReturnBtn: TButton;
|
||||
CloseBtn: TButton;
|
||||
CatIn: TBitBtn;
|
||||
CatOut: TBitBtn;
|
||||
CatEdit: TEdit;
|
||||
@ -46,19 +49,21 @@ type
|
||||
procedure RaterInClick(Sender: TObject);
|
||||
procedure RaterOutClick(Sender: TObject);
|
||||
procedure ResetBtnClick(Sender: TObject);
|
||||
procedure VarListSelectionChange(Sender: TObject; User: boolean);
|
||||
private
|
||||
{ private declarations }
|
||||
FAutoSized: Boolean;
|
||||
NoCats : integer;
|
||||
NoObjects : integer;
|
||||
NoRaters : integer;
|
||||
function compute_term1(R : IntDyneCube; i, j, k : integer) : double;
|
||||
function compute_term2(R : IntDyneCube; i, j, l : integer) : double;
|
||||
function compute_denom(R : IntDyneCube) : double;
|
||||
function compute_partial_pchance(R : IntDyneCube; i, j : integer;
|
||||
denom : double) : double;
|
||||
function compute_partial_pobs(R : IntDyneCube; k, l : integer) : double;
|
||||
function KappaVariance(R : IntDyneCube; n, m, K1 : integer) : double;
|
||||
NoCats: integer;
|
||||
NoObjects: integer;
|
||||
NoRaters: integer;
|
||||
function compute_term1(R: IntDyneCube; i, j, k: integer): double;
|
||||
function compute_term2(R: IntDyneCube; i, j, l: integer): double;
|
||||
function compute_denom(R: IntDyneCube): double;
|
||||
function compute_partial_pchance(R: IntDyneCube; i, j: integer; denom: double): double;
|
||||
function compute_partial_pobs(R: IntDyneCube; k, l: integer): double;
|
||||
function KappaVariance(R: IntDyneCube; n, m, K1: integer): double;
|
||||
|
||||
procedure UpdateBtnStates;
|
||||
|
||||
public
|
||||
{ public declarations }
|
||||
@ -70,7 +75,7 @@ var
|
||||
implementation
|
||||
|
||||
uses
|
||||
Math;
|
||||
Math, Utils;
|
||||
|
||||
{ TGenKappaFrm }
|
||||
|
||||
@ -92,185 +97,160 @@ begin
|
||||
end;
|
||||
|
||||
procedure TGenKappaFrm.CatInClick(Sender: TObject);
|
||||
VAR index : integer;
|
||||
var
|
||||
index: integer;
|
||||
begin
|
||||
index := VarList.ItemIndex;
|
||||
CatEdit.Text := VarList.Items.Strings[index];
|
||||
VarList.Items.Delete(index);
|
||||
CatIn.Enabled := false;
|
||||
CatOut.Enabled := true;
|
||||
index := VarList.ItemIndex;
|
||||
if (index > -1) and (CatEdit.Text = '') then
|
||||
begin
|
||||
CatEdit.Text := VarList.Items[index];
|
||||
VarList.Items.Delete(index);
|
||||
UpdateBtnStates;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TGenKappaFrm.CatOutClick(Sender: TObject);
|
||||
begin
|
||||
VarList.Items.Add(CatEdit.Text);
|
||||
CatEdit.Text := '';
|
||||
CatIn.Enabled := true;
|
||||
CatOut.Enabled := false;
|
||||
if CatEdit.Text <> '' then
|
||||
begin
|
||||
VarList.Items.Add(CatEdit.Text);
|
||||
CatEdit.Text := '';
|
||||
UpdateBtnStates;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TGenKappaFrm.ComputeBtnClick(Sender: TObject);
|
||||
VAR
|
||||
CatCol, ObjCol, RaterCol, frequency, i, j, k, l : integer;
|
||||
value, rater, category, anobject: integer;
|
||||
// int CatCol:=0, ObjCol:=0, RaterCol:=0;
|
||||
// int value, rater, category, object;
|
||||
R : IntDyneCube;
|
||||
// int ***R;
|
||||
pobs, pchance, kappa, num, denom, partial_pchance, a_priori : double;
|
||||
average_frequency : DblDyneVec;
|
||||
outline : array[0..131] of char;
|
||||
// char outline[131], astring[21];
|
||||
z : double;
|
||||
|
||||
var
|
||||
CatCol, ObjCol, RaterCol, frequency, i, j, k, l: integer;
|
||||
value, rater, category, anobject: integer;
|
||||
R: IntDyneCube;
|
||||
pobs, pchance, kappa, num, denom, partial_pchance, a_priori: double;
|
||||
average_frequency: DblDyneVec;
|
||||
z: double;
|
||||
lReport: TStrings;
|
||||
begin
|
||||
CatCol:=0;
|
||||
ObjCol:=0;
|
||||
RaterCol:=0;
|
||||
OutputFrm.RichEdit.Clear;
|
||||
OutputFrm.RichEdit.Lines.Add('Generalized Kappa Coefficient Procedure');
|
||||
OutputFrm.RichEdit.Lines.Add('adapted from the program written by Giovanni Flammia');
|
||||
OutputFrm.RichEdit.Lines.Add('copywritten 1995, M.I.T. Lab. for Computer Science');
|
||||
OutputFrm.RichEdit.Lines.Add('');
|
||||
lReport := TStringList.Create;
|
||||
try
|
||||
lReport.Add('GENERALIZED KAPPA COEFFICIENT PROCEDURE');
|
||||
lReport.Add('Adapted from the program written by Giovanni Flammia');
|
||||
lReport.Add('Copy-write 1995, M.I.T. Lab. for Computer Science');
|
||||
lReport.Add('');
|
||||
|
||||
// get columns for the variables
|
||||
for i := 0 to NoVariables - 1 do
|
||||
begin
|
||||
if (OS3MainFrm.DataGrid.Cells[i+1,0] = CatEdit.Text) then CatCol := i+1;
|
||||
if (OS3MainFrm.DataGrid.Cells[i+1,0] = RaterEdit.Text) then RaterCol := i+1;
|
||||
if (OS3MainFrm.DataGrid.Cells[i+1,0] = ObjectEdit.Text) then ObjCol := i+1;
|
||||
end;
|
||||
if ((CatCol = 0) or (RaterCol = 0) or (ObjCol = 0)) then
|
||||
begin
|
||||
ShowMessage('ERROR! One or more variables not defined.');
|
||||
exit;
|
||||
end;
|
||||
// get max no of codes for objects, raters, categories
|
||||
NoCats := 0;
|
||||
NoObjects := 0;
|
||||
NoRaters := 0;
|
||||
for i := 0 to NoCases - 1 do
|
||||
begin
|
||||
value := StrToInt(Trim(OS3MainFrm.DataGrid.Cells[CatCol,i+1]));
|
||||
// result := GetValue(i+1,CatCol,intvalue,dblvalue,strvalue);
|
||||
// if (result :=:= 1) value := 0;
|
||||
// else value := intvalue;
|
||||
if (value > NoCats) then NoCats := value;
|
||||
value := StrToInt(Trim(OS3MainFrm.DataGrid.Cells[ObjCol,i+1]));
|
||||
// result := GetValue(i+1,ObjCol,intvalue,dblvalue,strvalue);
|
||||
// if (result :=:= 1) value := 0;
|
||||
// else value := intvalue;
|
||||
if (value > NoObjects) then NoObjects := value;
|
||||
value := StrToInt(Trim(OS3MainFrm.DataGrid.Cells[RaterCol,i+1]));
|
||||
// result := GetValue(i+1,RaterCol,intvalue,dblvalue,strvalue);
|
||||
// if (result :=:= 1) value := 0;
|
||||
// else value := intvalue;
|
||||
if (value > NoRaters) then NoRaters := value;
|
||||
end;
|
||||
// get columns for the variables
|
||||
CatCol := 0;
|
||||
ObjCol := 0;
|
||||
RaterCol := 0;
|
||||
for i := 1 to NoVariables do
|
||||
begin
|
||||
if (OS3MainFrm.DataGrid.Cells[i, 0] = CatEdit.Text) then CatCol := i;
|
||||
if (OS3MainFrm.DataGrid.Cells[i, 0] = RaterEdit.Text) then RaterCol := i;
|
||||
if (OS3MainFrm.DataGrid.Cells[i, 0] = ObjectEdit.Text) then ObjCol := i;
|
||||
end;
|
||||
if ((CatCol = 0) or (RaterCol = 0) or (ObjCol = 0)) then
|
||||
begin
|
||||
MessageDlg('One or more variables not defined.', mtError, [mbOK], 0);
|
||||
exit;
|
||||
end;
|
||||
|
||||
outline := format('%d Raters using %d Categories to rate %d Objects',
|
||||
[NoRaters, NoCats, NoObjects]);
|
||||
OutputFrm.RichEdit.Lines.Add(outline);
|
||||
OutputFrm.RichEdit.Lines.Add('');
|
||||
// get max no of codes for objects, raters, categories
|
||||
NoCats := 0;
|
||||
NoObjects := 0;
|
||||
NoRaters := 0;
|
||||
for i := 1 to NoCases do
|
||||
begin
|
||||
value := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[CatCol, i])));
|
||||
if (value > NoCats) then NoCats := value;
|
||||
|
||||
// get memory for R and set to zero
|
||||
SetLength(R,NoRaters+1,NoCats+1,NoObjects+1);
|
||||
for i := 0 to NoRaters - 1 do
|
||||
begin
|
||||
for k := 0 to NoCats - 1 do
|
||||
begin
|
||||
for l := 0 to NoObjects - 1 do
|
||||
begin
|
||||
R[i,k,l] := 0;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
value := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[ObjCol, i])));
|
||||
if (value > NoObjects) then NoObjects := value;
|
||||
|
||||
// get memory for average_frequency
|
||||
SetLength(average_frequency,NoCats+1);
|
||||
for k := 0 to NoCats - 1 do average_frequency[k] := 0.0;
|
||||
value := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[RaterCol, i])));
|
||||
if (value > NoRaters) then NoRaters := value;
|
||||
end;
|
||||
|
||||
// read data and store in R
|
||||
for i := 0 to NoCases - 1 do
|
||||
begin
|
||||
rater := StrToInt(Trim(OS3MainFrm.DataGrid.Cells[RaterCol,i+1]));
|
||||
anobject := StrToInt(Trim(OS3MainFrm.DataGrid.Cells[ObjCol,i+1]));
|
||||
category := StrToInt(Trim(OS3MainFrm.DataGrid.Cells[CatCol,i+1]));
|
||||
R[rater-1,category-1,anobject-1] := 1;
|
||||
end;
|
||||
lReport.Add('%d Raters using %d Categories to rate %d Objects', [NoRaters, NoCats, NoObjects]);
|
||||
lReport.Add('');
|
||||
|
||||
//compute chance probability of agreement pchance for all raters
|
||||
pchance := 0.0;
|
||||
denom := compute_denom(R);
|
||||
for i := 0 to NoRaters - 1 do
|
||||
begin
|
||||
for j := 0 to NoRaters - 1 do
|
||||
begin
|
||||
if (i <> j) then
|
||||
begin
|
||||
partial_pchance := compute_partial_pchance(R,i,j,denom);
|
||||
pchance := pchance + partial_pchance;
|
||||
end;
|
||||
end;
|
||||
for k := 0 to NoCats - 1 do
|
||||
begin
|
||||
frequency := 0;
|
||||
for l := 0 to NoObjects - 1 do
|
||||
begin
|
||||
frequency := frequency + R[i,k,l];
|
||||
end;
|
||||
a_priori := frequency / NoObjects;
|
||||
outline := format('Frequency[%d,%d] := %f',[i+1,k+1,a_priori]);
|
||||
OutputFrm.RichEdit.Lines.Add(outline);
|
||||
end;
|
||||
end;
|
||||
// get memory for R and set to zero
|
||||
SetLength(R, NoRaters+1, NoCats+1, NoObjects+1);
|
||||
for i := 0 to NoRaters - 1 do
|
||||
for k := 0 to NoCats - 1 do
|
||||
for l := 0 to NoObjects - 1 do
|
||||
R[i,k,l] := 0;
|
||||
|
||||
for k := 0 to NoCats - 1 do
|
||||
begin
|
||||
for l := 0 to NoObjects - 1 do
|
||||
begin
|
||||
for i := 0 to NoRaters - 1 do
|
||||
begin
|
||||
average_frequency[k] := average_frequency[k] + R[i,k,l];
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
// get memory for average_frequency
|
||||
SetLength(average_frequency, NoCats+1);
|
||||
for k := 0 to NoCats - 1 do
|
||||
average_frequency[k] := 0.0;
|
||||
|
||||
for k := 0 to NoCats - 1 do
|
||||
begin
|
||||
average_frequency[k] := average_frequency[k] / (NoObjects * NoRaters);
|
||||
outline := format('Average_Frequency[%d] := %f',[k+1,average_frequency[k]]);
|
||||
OutputFrm.RichEdit.Lines.Add(outline);
|
||||
end;
|
||||
outline := format('PChance := %f',[pchance]);
|
||||
OutputFrm.RichEdit.Lines.Add(outline);
|
||||
// read data and store in R
|
||||
for i := 1 to NoCases do
|
||||
begin
|
||||
rater := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[RaterCol, i])));
|
||||
anobject := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[ObjCol, i])));
|
||||
category := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[CatCol, i])));
|
||||
R[rater-1, category-1, anobject-1] := 1;
|
||||
end;
|
||||
|
||||
// compute observed probability of agreement among all raters
|
||||
num := 0.0;
|
||||
for k := 0 to NoCats - 1 do
|
||||
begin
|
||||
for l := 0 to NoObjects - 1 do
|
||||
begin
|
||||
num := num + compute_partial_pobs(R,k,l);
|
||||
end;
|
||||
end;
|
||||
if (denom > 0.0) then pobs := num / denom
|
||||
else pobs := 0.0;
|
||||
outline := format('PObs := %f',[pobs]);
|
||||
OutputFrm.RichEdit.Lines.Add(outline);
|
||||
//compute chance probability of agreement pchance for all raters
|
||||
pchance := 0.0;
|
||||
denom := compute_denom(R);
|
||||
for i := 0 to NoRaters - 1 do
|
||||
begin
|
||||
for j := 0 to NoRaters - 1 do
|
||||
if (i <> j) then
|
||||
begin
|
||||
partial_pchance := compute_partial_pchance(R,i,j,denom);
|
||||
pchance := pchance + partial_pchance;
|
||||
end;
|
||||
for k := 0 to NoCats - 1 do
|
||||
begin
|
||||
frequency := 0;
|
||||
for l := 0 to NoObjects - 1 do
|
||||
frequency := frequency + R[i,k,l];
|
||||
a_priori := frequency / NoObjects;
|
||||
lReport.Add('Frequency[%d,%d]: %f', [i+1, k+1, a_priori]);
|
||||
end;
|
||||
end;
|
||||
|
||||
kappa := (pobs - pchance) / (1.0 - pchance);
|
||||
outline := format('Kappa := %f',[kappa]);
|
||||
OutputFrm.RichEdit.Lines.Add(outline);
|
||||
z := KappaVariance(R,NoObjects,NoRaters,NoCats);
|
||||
if (z > 0.0) then z := kappa / sqrt(z);
|
||||
outline := format('z for Kappa := %8.3f with probability > %8.3f',[z,1.0-probz(z)]);
|
||||
OutputFrm.RichEdit.Lines.Add(outline);
|
||||
OutputFrm.ShowModal;
|
||||
for k := 0 to NoCats - 1 do
|
||||
for l := 0 to NoObjects - 1 do
|
||||
for i := 0 to NoRaters - 1 do
|
||||
average_frequency[k] := average_frequency[k] + R[i,k,l];
|
||||
|
||||
// clean up space allocated
|
||||
average_frequency := nil;
|
||||
R := nil;
|
||||
for k := 0 to NoCats - 1 do
|
||||
begin
|
||||
average_frequency[k] := average_frequency[k] / (NoObjects * NoRaters);
|
||||
lReport.Add('Average_Frequency[%d]: %f', [k+1, average_frequency[k]]);
|
||||
end;
|
||||
|
||||
lReport.Add('PChance: %f', [pchance]);
|
||||
|
||||
// compute observed probability of agreement among all raters
|
||||
num := 0.0;
|
||||
for k := 0 to NoCats - 1 do
|
||||
for l := 0 to NoObjects - 1 do
|
||||
num := num + compute_partial_pobs(R,k,l);
|
||||
if (denom > 0.0) then
|
||||
pobs := num / denom
|
||||
else
|
||||
pobs := 0.0;
|
||||
lReport.Add('PObs: %f', [pobs]);
|
||||
|
||||
kappa := (pobs - pchance) / (1.0 - pchance);
|
||||
lReport.Add('Kappa: %f', [kappa]);
|
||||
|
||||
z := KappaVariance(R,NoObjects,NoRaters,NoCats);
|
||||
if (z > 0.0) then z := kappa / sqrt(z);
|
||||
lReport.Add('z for Kappa: %.3f with probability > %.3f', [z, 1.0-probz(z)]);
|
||||
|
||||
DisplayReport(lReport);
|
||||
|
||||
finally
|
||||
lReport.Free;
|
||||
average_frequency := nil;
|
||||
R := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TGenKappaFrm.FormActivate(Sender: TObject);
|
||||
@ -279,12 +259,11 @@ var
|
||||
begin
|
||||
if FAutoSized then
|
||||
exit;
|
||||
w := MaxValue([HelpBtn.Width, ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]);
|
||||
w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]);
|
||||
HelpBtn.Constraints.MinWidth := w;
|
||||
ResetBtn.Constraints.MinWidth := w;
|
||||
CancelBtn.Constraints.MinWidth := w;
|
||||
ComputeBtn.Constraints.MinWidth := w;
|
||||
ReturnBtn.Constraints.MinWidth := w;
|
||||
CloseBtn.Constraints.MinWidth := w;
|
||||
|
||||
Constraints.MinWidth := Width;
|
||||
Constraints.MinHeight := Height;
|
||||
@ -295,8 +274,6 @@ end;
|
||||
procedure TGenKappaFrm.FormCreate(Sender: TObject);
|
||||
begin
|
||||
Assert(OS3MainFrm <> nil);
|
||||
if OutputFrm = nil then
|
||||
Application.CreateForm(TOutputFrm, OutputFrm);
|
||||
end;
|
||||
|
||||
procedure TGenKappaFrm.FormShow(Sender: TObject);
|
||||
@ -308,207 +285,222 @@ procedure TGenKappaFrm.HelpBtnClick(Sender: TObject);
|
||||
begin
|
||||
if ContextHelpForm = nil then
|
||||
Application.CreateForm(TContextHelpForm, ContextHelpForm);
|
||||
ContextHelpForm.HelpMessage((Sender as TButton).tag);
|
||||
ContextHelpForm.HelpMessage((Sender as TButton).Tag);
|
||||
end;
|
||||
|
||||
function TGenKappaFrm.compute_term1(R : IntDyneCube; i, j, k : integer) : double;
|
||||
VAR
|
||||
function TGenKappaFrm.compute_term1(R: IntDyneCube; i, j, k: integer): double;
|
||||
var
|
||||
kk : integer; // range over 0 .. num_categories-1 */
|
||||
l,ll : integer; // range over 0 .. num_points-1 */
|
||||
denom_i : integer; //:=0;
|
||||
denom_j : integer; //:=0;
|
||||
num_i : integer; //:=0;
|
||||
num_j : integer; //:=0;
|
||||
|
||||
begin
|
||||
denom_i := 0;
|
||||
denom_j := 0;
|
||||
num_i := 0;
|
||||
num_j := 0;
|
||||
|
||||
for kk := 0 to NoCats - 1 do
|
||||
begin
|
||||
for ll := 0 to NoObjects - 1 do
|
||||
begin
|
||||
denom_i := denom_i + R[i,kk,ll];
|
||||
denom_j := denom_j + R[j,kk,ll];
|
||||
denom_i := denom_i + R[i, kk, ll];
|
||||
denom_j := denom_j + R[j, kk, ll];
|
||||
end;
|
||||
end;
|
||||
|
||||
for l := 0 to NoObjects - 1 do
|
||||
begin
|
||||
num_i := num_i + R[i,k,l];
|
||||
num_j := num_j + R[j,k,l];
|
||||
num_i := num_i + R[i, k, l];
|
||||
num_j := num_j + R[j, k, l];
|
||||
end;
|
||||
|
||||
result := ((num_i / denom_i) * (num_j / denom_j));
|
||||
result := (num_i * num_j) / (denom_i * denom_j); //((num_i / denom_i) * (num_j / denom_j));
|
||||
end;
|
||||
|
||||
function TGenKappaFrm.compute_term2(R : IntDyneCube; i, j, l : integer) : double;
|
||||
VAR
|
||||
sum_i, sum_j, k : integer;
|
||||
function TGenKappaFrm.compute_term2(R: IntDyneCube; i, j, l: integer): double;
|
||||
var
|
||||
sum_i, sum_j, k: integer;
|
||||
begin
|
||||
sum_i:=0;
|
||||
sum_j:=0;
|
||||
sum_i := 0;
|
||||
sum_j := 0;
|
||||
|
||||
for k := 0 to NoCats - 1 do
|
||||
begin
|
||||
sum_i := sum_i + R[i,k,l];
|
||||
sum_j := sum_j + R[j,k,l];
|
||||
sum_i := sum_i + R[i, k, l];
|
||||
sum_j := sum_j + R[j, k, l];
|
||||
end;
|
||||
|
||||
result := (sum_i * sum_j );
|
||||
Result := sum_i * sum_j;
|
||||
end;
|
||||
|
||||
//---------------------------------------------------------------------------
|
||||
|
||||
function TGenKappaFrm.compute_denom(R : IntDyneCube) : double;
|
||||
VAR
|
||||
sum : IntDyneVec;
|
||||
aresult : double;
|
||||
i, k, l : integer;
|
||||
function TGenKappaFrm.compute_denom(R: IntDyneCube): double;
|
||||
var
|
||||
sum: IntDyneVec;
|
||||
i, k, l: integer;
|
||||
begin
|
||||
aresult := 0;
|
||||
Result := 0;
|
||||
|
||||
SetLength(sum,NoObjects); // sum := (int *)calloc(num_points,sizeof(int));
|
||||
SetLength(sum, NoObjects); // sum := (int *)calloc(num_points,sizeof(int));
|
||||
for l := 0 to NoObjects - 1 do
|
||||
begin
|
||||
sum[l] := 0;
|
||||
for i := 0 to NoRaters - 1 do
|
||||
begin
|
||||
for k := 0 to NoCats - 1 do
|
||||
begin
|
||||
sum[l] := sum[l] + R[i,k,l];
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
for l := 0 to NoObjects - 1 do
|
||||
begin
|
||||
aresult := aresult + sum[l] * ( sum[l] - 1);
|
||||
end;
|
||||
Result := Result + sum[l] * (sum[l] - 1);
|
||||
|
||||
sum := nil;
|
||||
result := aresult;
|
||||
end;
|
||||
|
||||
function TGenKappaFrm.compute_partial_pchance(R : IntDyneCube; i, j : integer;
|
||||
denom : double) : double;
|
||||
VAR
|
||||
term1, term2 : double;
|
||||
k, l : integer;
|
||||
function TGenKappaFrm.compute_partial_pchance(R: IntDyneCube; i, j: integer;
|
||||
denom: double): double;
|
||||
var
|
||||
term1, term2: double;
|
||||
k, l: integer;
|
||||
begin
|
||||
term1 := 0;
|
||||
term2 := 0;
|
||||
|
||||
for k := 0 to NoCats - 1 do
|
||||
begin
|
||||
term1 := term1 + compute_term1(R,i,j,k);
|
||||
end;
|
||||
|
||||
for l := 0 to NoObjects - 1 do
|
||||
begin
|
||||
term2 := term2 + compute_term2(R,i,j,l);
|
||||
end;
|
||||
if (denom > 0.0) then result := ( term1 * ( term2 / denom ) )
|
||||
else result := 0.0;
|
||||
end;
|
||||
//---------------------------------------------------------------------------
|
||||
|
||||
function TGenKappaFrm.compute_partial_pobs(R : IntDyneCube; k, l : integer) : double;
|
||||
VAR
|
||||
sum, i : integer;
|
||||
if (denom > 0.0) then
|
||||
Result := term1 * term2 / denom
|
||||
else
|
||||
Result := 0.0;
|
||||
end;
|
||||
|
||||
function TGenKappaFrm.compute_partial_pobs(R: IntDyneCube; k, l: integer): double;
|
||||
var
|
||||
sum, i: integer;
|
||||
begin
|
||||
sum := 0;
|
||||
|
||||
for i := 0 to NoRaters - 1 do
|
||||
begin
|
||||
sum := sum + R[i,k,l];
|
||||
end;
|
||||
sum := sum + R[i, k, l];
|
||||
|
||||
result := (sum * (sum - 1));
|
||||
Result := sum * (sum - 1);
|
||||
end;
|
||||
|
||||
function TGenKappaFrm.KappaVariance(R : IntDyneCube; n, m, K1 : integer) : double;
|
||||
VAR
|
||||
xij, variance, term1, term2 : double;
|
||||
i, j, k : integer;
|
||||
pj : DblDyneVec;
|
||||
|
||||
{ Calculates the variance of Kappa
|
||||
R contains 1's or 0's for raters, categories and objects (row, col, slice)
|
||||
m is number of raters
|
||||
n is number of subjects
|
||||
K1 is the number of categories }
|
||||
function TGenKappaFrm.KappaVariance(R : IntDyneCube; n, m, K1: integer): double;
|
||||
var
|
||||
xij, term1, term2: double;
|
||||
i, j, k: integer;
|
||||
pj: DblDyneVec;
|
||||
begin
|
||||
// calculates the variance of Kappa
|
||||
// R contains 1's or 0's for raters, categories and objects (row, col, slice)
|
||||
// m is number of raters
|
||||
// n is number of subjects
|
||||
// K1 is the number of categories
|
||||
term1 := 0.0;
|
||||
term2 := 0.0;
|
||||
|
||||
term1 := 0.0;
|
||||
term2 := 0.0;
|
||||
SetLength(pj,K1);
|
||||
for j := 0 to K1 - 1 do pj[j] := 0.0;
|
||||
SetLength(pj,K1);
|
||||
for j := 0 to K1 - 1 do pj[j] := 0.0;
|
||||
|
||||
// get proportion of values in each category
|
||||
for j := 0 to K1 - 1 do // accross categories
|
||||
begin
|
||||
xij := 0.0;
|
||||
for i := 0 to m - 1 do // accross raters
|
||||
begin
|
||||
for k := 0 to n - 1 do // accross objects
|
||||
begin
|
||||
xij := xij + R[i,j,k];
|
||||
end;
|
||||
end;
|
||||
// get proportion of values in each category
|
||||
for j := 0 to K1 - 1 do // accross categories
|
||||
begin
|
||||
xij := 0.0;
|
||||
for i := 0 to m - 1 do // accross raters
|
||||
for k := 0 to n - 1 do // accross objects
|
||||
xij := xij + R[i,j,k];
|
||||
pj[j] := pj[j] + xij;
|
||||
end;
|
||||
for j := 0 to K1 - 1 do pj[j] := pj[j] / (n * m);
|
||||
for j := 0 to K1 - 1 do
|
||||
begin
|
||||
term1 := term1 +(pj[j] * (1.0 - pj[j]));
|
||||
term2 := term2 + (pj[j] * (1.0 - pj[j]) * (1.0 - 2.0 * pj[j]));
|
||||
end;
|
||||
term1 := term1 * term1;
|
||||
if ((term1 > 0) and (term2 > 0)) then
|
||||
variance := (2.0 / (n * m * (m-1) * term1)) * (term1 - term2)
|
||||
else variance := 0.0;
|
||||
pj := nil;
|
||||
result := variance;
|
||||
end;
|
||||
|
||||
for j := 0 to K1 - 1 do
|
||||
pj[j] := pj[j] / (n * m);
|
||||
|
||||
for j := 0 to K1 - 1 do
|
||||
begin
|
||||
term1 := term1 + (pj[j] * (1.0 - pj[j]));
|
||||
term2 := term2 + (pj[j] * (1.0 - pj[j]) * (1.0 - 2.0 * pj[j]));
|
||||
end;
|
||||
|
||||
term1 := term1 * term1;
|
||||
if (term1 > 0) and (term2 > 0) then
|
||||
Result := (2.0 / (n * m * (m-1) * term1)) * (term1 - term2)
|
||||
else
|
||||
Result := 0.0;
|
||||
|
||||
pj := nil;
|
||||
end;
|
||||
|
||||
procedure TGenKappaFrm.ObjInClick(Sender: TObject);
|
||||
VAR index : integer;
|
||||
var
|
||||
index: integer;
|
||||
begin
|
||||
index := VarList.ItemIndex;
|
||||
|
||||
ObjectEdit.Text := VarList.Items.Strings[index];
|
||||
VarList.Items.Delete(index);
|
||||
ObjIn.Enabled := false;
|
||||
ObjOut.Enabled := true;
|
||||
index := VarList.ItemIndex;
|
||||
if (index > -1) and (ObjectEdit.Text = '') then
|
||||
begin
|
||||
ObjectEdit.Text := VarList.Items[index];
|
||||
VarList.Items.Delete(index);
|
||||
UpdateBtnStates;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TGenKappaFrm.ObjOutClick(Sender: TObject);
|
||||
begin
|
||||
VarList.Items.Add(ObjectEdit.Text);
|
||||
ObjectEdit.Text := '';
|
||||
ObjIn.Enabled := true;
|
||||
ObjOut.Enabled := false;
|
||||
if ObjectEdit.Text <> '' then
|
||||
begin
|
||||
VarList.Items.Add(ObjectEdit.Text);
|
||||
ObjectEdit.Text := '';
|
||||
UpdateBtnStates;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TGenKappaFrm.RaterInClick(Sender: TObject);
|
||||
VAR index : integer;
|
||||
var
|
||||
index: integer;
|
||||
begin
|
||||
index := VarList.ItemIndex;
|
||||
|
||||
RaterEdit.Text := VarList.Items.Strings[index];
|
||||
VarList.Items.Delete(index);
|
||||
RaterIn.Enabled := false;
|
||||
RaterOut.Enabled := true;
|
||||
index := VarList.ItemIndex;
|
||||
if (index > -1) and (RaterEdit.Text = '') then
|
||||
begin
|
||||
RaterEdit.Text := VarList.Items.Strings[index];
|
||||
VarList.Items.Delete(index);
|
||||
UpdateBtnStates;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TGenKappaFrm.RaterOutClick(Sender: TObject);
|
||||
begin
|
||||
VarList.Items.Add(RaterEdit.Text);
|
||||
RaterEdit.Text := '';
|
||||
RaterIn.Enabled := true;
|
||||
RaterOut.Enabled := false;
|
||||
if RaterEdit.Text <> '' then
|
||||
begin
|
||||
VarList.Items.Add(RaterEdit.Text);
|
||||
RaterEdit.Text := '';
|
||||
UpdateBtnStates;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TGenKappaFrm.UpdateBtnStates;
|
||||
var
|
||||
lSelected: Boolean;
|
||||
begin
|
||||
lSelected := AnySelected(VarList);
|
||||
|
||||
CatIn.Enabled := lSelected and (CatEdit.Text = '');
|
||||
CatOut.Enabled := (CatEdit.Text <> '');
|
||||
|
||||
ObjIn.Enabled := lSelected and (ObjectEdit.Text = '');
|
||||
ObjOut.Enabled := (ObjectEdit.Text <> '');
|
||||
|
||||
RaterIn.Enabled := lSelected and (RaterEdit.Text = '');
|
||||
RaterOut.Enabled := (RaterEdit.Text <> '');
|
||||
end;
|
||||
|
||||
procedure TGenKappaFrm.VarListSelectionChange(Sender: TObject; User: boolean);
|
||||
begin
|
||||
UpdateBtnStates;
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
{$I genkappaunit.lrs}
|
||||
|
||||
|
||||
Reference in New Issue
Block a user