pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

LazStats: Inherit GenKappaUnit from TBasicStatsReportForm.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7821 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-10-27 22:21:24 +00:00
parent e3a44f85d3
commit 38db0c2fba
2 changed files with 215 additions and 298 deletions
Download Patch File Download Diff File Expand all files Collapse all files

314
applications/lazstats/source/forms/analysis/nonparametric/genkappaunit.lfm
View File

@ -1,162 +1,78 @@
object GenKappaFrm: TGenKappaFrm inherited GenKappaFrm: TGenKappaFrm
Left = 641 Left = 641
Height = 356 Height = 306
Top = 378 Top = 378
Width = 468 Width = 452
HelpType = htKeyword HelpType = htKeyword
HelpKeyword = 'html/GeneralizedKappa.htm' HelpKeyword = 'html/GeneralizedKappa.htm'
AutoSize = True
Caption = 'Generalized Kappa Coefficient' Caption = 'Generalized Kappa Coefficient'
ClientHeight = 356 ClientHeight = 306
ClientWidth = 468
OnActivate = FormActivate
OnCreate = FormCreate
OnShow = FormShow
Position = poMainFormCenter
LCLVersion = '2.1.0.0'
object ResetBtn: TButton
AnchorSideRight.Control = ComputeBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 259
Height = 25
Top = 323
Width = 54
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Reset'
OnClick = ResetBtnClick
TabOrder = 2
end
object ComputeBtn: TButton
AnchorSideRight.Control = CloseBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 321
Height = 25
Top = 323
Width = 76
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Compute'
OnClick = ComputeBtnClick
TabOrder = 3
end
object CloseBtn: TButton
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 405
Height = 25
Top = 323
Width = 55
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Close'
ModalResult = 11
TabOrder = 4
end
object HelpBtn: TButton
Tag = 125
AnchorSideRight.Control = ResetBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 200
Height = 25
Top = 323
Width = 51
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Help'
OnClick = HelpBtnClick
TabOrder = 1
end
object Bevel1: TBevel
AnchorSideLeft.Control = Owner
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = ComputeBtn
Left = 0
Height = 8
Top = 307
Width = 468
Anchors = [akLeft, akRight, akBottom]
Shape = bsBottomLine
end
object Panel1: TPanel
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Bevel1
Left = 8
Height = 299
Top = 8
Width = 452
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BevelOuter = bvNone
ClientHeight = 299
ClientWidth = 452 ClientWidth = 452
TabOrder = 0 inherited ParamsPanel: TPanel
object Label1: TLabel Height = 290
Width = 296
ClientHeight = 290
ClientWidth = 296
inherited CloseBtn: TButton
Left = 241
Top = 265
end
inherited ComputeBtn: TButton
Left = 157
Top = 265
end
inherited ResetBtn: TButton
Left = 95
Top = 265
end
inherited HelpBtn: TButton
Tag = 125
Left = 36
Top = 265
end
inherited ButtonBevel: TBevel
Top = 249
Width = 296
end
object Label1: TLabel[5]
AnchorSideLeft.Control = CatEdit AnchorSideLeft.Control = CatEdit
AnchorSideBottom.Control = CatEdit AnchorSideBottom.Control = CatEdit
Left = 248 Left = 167
Height = 15 Height = 15
Top = 25 Top = 21
Width = 117 Width = 117
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 2 BorderSpacing.Bottom = 2
Caption = 'Category Code (1,2,...)' Caption = 'Category Code (1,2,...)'
ParentColor = False ParentColor = False
end end
object Label2: TLabel object Label2: TLabel[6]
AnchorSideLeft.Control = ObjectEdit AnchorSideLeft.Control = ObjectEdit
AnchorSideBottom.Control = ObjectEdit AnchorSideBottom.Control = ObjectEdit
Left = 248 Left = 167
Height = 15 Height = 15
Top = 117 Top = 109
Width = 144 Width = 144
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 2 BorderSpacing.Bottom = 2
Caption = 'Object or Subject Classified' Caption = 'Object or Subject Classified'
ParentColor = False ParentColor = False
end end
object Label3: TLabel object Label3: TLabel[7]
AnchorSideLeft.Control = RaterEdit AnchorSideLeft.Control = RaterEdit
AnchorSideBottom.Control = RaterEdit AnchorSideBottom.Control = RaterEdit
Left = 248 Left = 167
Height = 15 Height = 15
Top = 209 Top = 197
Width = 101 Width = 101
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 2 BorderSpacing.Bottom = 2
Caption = 'Rater Codes (1,2,...)' Caption = 'Rater Codes (1,2,...)'
ParentColor = False ParentColor = False
end end
object Label4: TLabel object Label4: TLabel[8]
AnchorSideLeft.Control = Panel1 AnchorSideLeft.Control = ParamsPanel
AnchorSideTop.Control = Panel1 AnchorSideTop.Control = ParamsPanel
Left = 0 Left = 0
Height = 15 Height = 15
Top = 0 Top = 0
@ -164,173 +80,177 @@ object GenKappaFrm: TGenKappaFrm
Caption = 'Variables:' Caption = 'Variables:'
ParentColor = False ParentColor = False
end end
object VarList: TListBox object VarList: TListBox[9]
AnchorSideLeft.Control = Panel1 AnchorSideLeft.Control = ParamsPanel
AnchorSideTop.Control = Label4 AnchorSideTop.Control = Label4
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = CatIn AnchorSideRight.Control = CatIn
AnchorSideBottom.Control = Panel1
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 0 Left = 0
Height = 282 Height = 232
Top = 17 Top = 17
Width = 204 Width = 129
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Top = 2 BorderSpacing.Top = 2
BorderSpacing.Right = 8 BorderSpacing.Right = 6
ItemHeight = 0 ItemHeight = 0
OnDblClick = VarListDblClick
OnSelectionChange = VarListSelectionChange OnSelectionChange = VarListSelectionChange
TabOrder = 0 TabOrder = 4
end end
object CatIn: TBitBtn object CatIn: TBitBtn[10]
AnchorSideLeft.Control = Panel1 AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = VarList AnchorSideTop.Control = VarList
Left = 212 Left = 135
Height = 28 Height = 26
Top = 17 Top = 17
Width = 28 Width = 26
Images = MainDataModule.ImageList Images = MainDataModule.ImageList
ImageIndex = 1 ImageIndex = 1
OnClick = CatInClick OnClick = CatInClick
Spacing = 0 Spacing = 0
TabOrder = 1 TabOrder = 5
end end
object CatOut: TBitBtn object CatOut: TBitBtn[11]
AnchorSideLeft.Control = Panel1 AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = CatIn AnchorSideTop.Control = CatIn
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 212 Left = 135
Height = 28 Height = 26
Top = 49 Top = 47
Width = 28 Width = 26
BorderSpacing.Top = 4 BorderSpacing.Top = 4
Images = MainDataModule.ImageList Images = MainDataModule.ImageList
ImageIndex = 0 ImageIndex = 0
OnClick = CatOutClick OnClick = CatOutClick
Spacing = 0 Spacing = 0
TabOrder = 2 TabOrder = 6
end end
object ObjIn: TBitBtn object ObjIn: TBitBtn[12]
AnchorSideLeft.Control = Panel1 AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = CatOut AnchorSideTop.Control = CatOut
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 212 Left = 135
Height = 28 Height = 26
Top = 109 Top = 105
Width = 28 Width = 26
BorderSpacing.Top = 32 BorderSpacing.Top = 32
Images = MainDataModule.ImageList Images = MainDataModule.ImageList
ImageIndex = 1 ImageIndex = 1
OnClick = ObjInClick OnClick = ObjInClick
Spacing = 0 Spacing = 0
TabOrder = 4 TabOrder = 7
end end
object ObjOut: TBitBtn object ObjOut: TBitBtn[13]
AnchorSideLeft.Control = Panel1 AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = ObjIn AnchorSideTop.Control = ObjIn
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 212 Left = 135
Height = 28 Height = 26
Top = 141 Top = 135
Width = 28 Width = 26
BorderSpacing.Top = 4 BorderSpacing.Top = 4
Images = MainDataModule.ImageList Images = MainDataModule.ImageList
ImageIndex = 0 ImageIndex = 0
OnClick = ObjOutClick OnClick = ObjOutClick
Spacing = 0 Spacing = 0
TabOrder = 5 TabOrder = 8
end end
object RaterIn: TBitBtn object RaterIn: TBitBtn[14]
AnchorSideLeft.Control = Panel1 AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = ObjOut AnchorSideTop.Control = ObjOut
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 212 Left = 135
Height = 28 Height = 26
Top = 201 Top = 193
Width = 28 Width = 26
BorderSpacing.Top = 32 BorderSpacing.Top = 32
Images = MainDataModule.ImageList Images = MainDataModule.ImageList
ImageIndex = 1 ImageIndex = 1
OnClick = RaterInClick OnClick = RaterInClick
Spacing = 0 Spacing = 0
TabOrder = 7 TabOrder = 9
end end
object RaterOut: TBitBtn object RaterOut: TBitBtn[15]
AnchorSideLeft.Control = Panel1 AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = RaterIn AnchorSideTop.Control = RaterIn
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 212 Left = 135
Height = 28 Height = 26
Top = 233 Top = 223
Width = 28 Width = 26
BorderSpacing.Top = 4 BorderSpacing.Top = 4
Images = MainDataModule.ImageList Images = MainDataModule.ImageList
ImageIndex = 0 ImageIndex = 0
OnClick = RaterOutClick OnClick = RaterOutClick
Spacing = 0 Spacing = 0
TabOrder = 8 TabOrder = 10
end end
object CatEdit: TEdit object CatEdit: TEdit[16]
AnchorSideLeft.Control = CatIn AnchorSideLeft.Control = CatIn
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Panel1 AnchorSideRight.Control = ParamsPanel
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = CatOut AnchorSideBottom.Control = CatOut
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 248 Left = 167
Height = 23 Height = 23
Top = 42 Top = 38
Width = 204 Width = 129
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 8 BorderSpacing.Left = 6
BorderSpacing.Bottom = 12 BorderSpacing.Bottom = 12
ReadOnly = True ReadOnly = True
TabOrder = 3 TabOrder = 11
Text = 'CatEdit' Text = 'CatEdit'
end end
object ObjectEdit: TEdit object ObjectEdit: TEdit[17]
AnchorSideLeft.Control = ObjOut AnchorSideLeft.Control = CatIn
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideRight.Control = Panel1 AnchorSideRight.Control = ParamsPanel
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = ObjOut AnchorSideBottom.Control = ObjOut
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 248 Left = 167
Height = 23 Height = 23
Top = 134 Top = 126
Width = 204 Width = 129
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 8 BorderSpacing.Left = 6
BorderSpacing.Bottom = 12 BorderSpacing.Bottom = 12
ReadOnly = True ReadOnly = True
TabOrder = 6 TabOrder = 12
Text = 'ObjectEdit' Text = 'ObjectEdit'
end end
object RaterEdit: TEdit object RaterEdit: TEdit[18]
AnchorSideLeft.Control = RaterOut AnchorSideLeft.Control = CatIn
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = RaterIn AnchorSideTop.Control = RaterIn
AnchorSideRight.Control = Panel1 AnchorSideRight.Control = ParamsPanel
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = RaterOut AnchorSideBottom.Control = RaterOut
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 248 Left = 167
Height = 23 Height = 23
Top = 226 Top = 214
Width = 204 Width = 129
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 8 BorderSpacing.Left = 6
BorderSpacing.Bottom = 12 BorderSpacing.Bottom = 12
ReadOnly = True ReadOnly = True
TabOrder = 9 TabOrder = 13
Text = 'RaterEdit' Text = 'RaterEdit'
end end
end end
inherited ParamsSplitter: TSplitter
Left = 308
Height = 306
end
end end

195
applications/lazstats/source/forms/analysis/nonparametric/genkappaunit.pas
View File

@ -9,21 +9,15 @@ unit GenKappaUnit;
interface interface
uses uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
StdCtrls, ExtCtrls, Buttons, MainUnit, StdCtrls, ExtCtrls, Buttons, MainUnit,
Globals, OutputUnit, FunctionsLib, ContextHelpUnit; Globals, FunctionsLib, BasicStatsReportFormUnit;
type type
{ TGenKappaFrm } { TGenKappaFrm }
TGenKappaFrm = class(TForm) TGenKappaFrm = class(TBasicStatsReportForm)
Bevel1: TBevel;
HelpBtn: TButton;
Label4: TLabel; Label4: TLabel;
Panel1: TPanel;
ResetBtn: TButton;
ComputeBtn: TButton;
CloseBtn: TButton;
CatIn: TBitBtn; CatIn: TBitBtn;
CatOut: TBitBtn; CatOut: TBitBtn;
CatEdit: TEdit; CatEdit: TEdit;
@ -39,20 +33,14 @@ type
VarList: TListBox; VarList: TListBox;
procedure CatInClick(Sender: TObject); procedure CatInClick(Sender: TObject);
procedure CatOutClick(Sender: TObject); procedure CatOutClick(Sender: TObject);
procedure ComputeBtnClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure HelpBtnClick(Sender: TObject);
procedure ObjInClick(Sender: TObject); procedure ObjInClick(Sender: TObject);
procedure ObjOutClick(Sender: TObject); procedure ObjOutClick(Sender: TObject);
procedure RaterInClick(Sender: TObject); procedure RaterInClick(Sender: TObject);
procedure RaterOutClick(Sender: TObject); procedure RaterOutClick(Sender: TObject);
procedure ResetBtnClick(Sender: TObject); procedure VarListDblClick(Sender: TObject);
procedure VarListSelectionChange(Sender: TObject; User: boolean); procedure VarListSelectionChange(Sender: TObject; {%H-}User: boolean);
private private
{ private declarations }
FAutoSized: Boolean;
NoCats: integer; NoCats: integer;
NoObjects: integer; NoObjects: integer;
NoRaters: integer; NoRaters: integer;
@ -63,10 +51,13 @@ type
function compute_partial_pobs(R: IntDyneCube; k, l: integer): double; function compute_partial_pobs(R: IntDyneCube; k, l: integer): double;
function KappaVariance(R: IntDyneCube; n, m, K1: integer): double; function KappaVariance(R: IntDyneCube; n, m, K1: integer): double;
procedure UpdateBtnStates; protected
procedure AdjustConstraints; override;
procedure Compute; override;
procedure UpdateBtnStates; override;
public public
{ public declarations } procedure Reset; override;
end; end;
var var
@ -74,28 +65,27 @@ var
implementation implementation
{$R *.lfm}
uses uses
Math, Utils; Math,
Utils, GridProcs;
{ TGenKappaFrm } { TGenKappaFrm }
procedure TGenKappaFrm.ResetBtnClick(Sender: TObject); procedure TGenKappaFrm.AdjustConstraints;
VAR i : integer;
begin begin
CatIn.Enabled := true; inherited;
CatOut.Enabled := false; ParamsPanel.Constraints.MinWidth := Max(
ObjIn.Enabled := true; 4*CloseBtn.Width + 3*CloseBtn.BorderSpacing.Left,
ObjOut.Enabled := false; Label2.Width *2 + CatIn.Width + 2*VarList.BorderSpacing.Right
RaterIn.Enabled := true; );
RaterOut.Enabled := false; ParamsPanel.Constraints.MinHeight := RaterOut.Top + RaterOut.Height +
CatEdit.Text := ''; ButtonBevel.Height + CloseBtn.BorderSpacing.Top + CloseBtn.Height;
ObjectEdit.Text := '';
RaterEdit.Text := '';
VarList.Clear;
for i := 0 to NoVariables - 1 do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i+1,0]);
end; end;
procedure TGenKappaFrm.CatInClick(Sender: TObject); procedure TGenKappaFrm.CatInClick(Sender: TObject);
var var
index: integer; index: integer;
@ -109,6 +99,7 @@ begin
end; end;
end; end;
procedure TGenKappaFrm.CatOutClick(Sender: TObject); procedure TGenKappaFrm.CatOutClick(Sender: TObject);
begin begin
if CatEdit.Text <> '' then if CatEdit.Text <> '' then
@ -119,13 +110,14 @@ begin
end; end;
end; end;
procedure TGenKappaFrm.ComputeBtnClick(Sender: TObject);
procedure TGenKappaFrm.Compute;
var var
CatCol, ObjCol, RaterCol, frequency, i, j, k, l: integer; CatCol, ObjCol, RaterCol, frequency, i, j, k, l: integer;
value, rater, category, anobject: integer; value, rater, category, anobject: integer;
R: IntDyneCube; R: IntDyneCube = nil;
pobs, pchance, kappa, num, denom, partial_pchance, a_priori: double; pobs, pchance, kappa, num, denom, partial_pchance, a_priori: double;
average_frequency: DblDyneVec; average_frequency: DblDyneVec = nil;
z: double; z: double;
lReport: TStrings; lReport: TStrings;
begin begin
@ -137,18 +129,12 @@ begin
lReport.Add(''); lReport.Add('');
// get columns for the variables // get columns for the variables
CatCol := 0; CatCol := GetVariableIndex(OS3MainFrm.DataGrid, CatEdit.Text);
ObjCol := 0; ObjCol := GetVariableIndex(OS3MainFrm.DataGrid, ObjectEdit.Text);
RaterCol := 0; RaterCol := GetVariableIndex(OS3MainFrm.DataGrid, RaterEdit.Text);
for i := 1 to NoVariables do if ((CatCol = -1) or (RaterCol = -1) or (ObjCol = -1)) then
begin begin
if (OS3MainFrm.DataGrid.Cells[i, 0] = CatEdit.Text) then CatCol := i; ErrorMsg('One or more variables not defined.');
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; exit;
end; end;
@ -171,19 +157,19 @@ begin
lReport.Add('%d Raters using %d Categories to rate %d Objects', [NoRaters, NoCats, NoObjects]); lReport.Add('%d Raters using %d Categories to rate %d Objects', [NoRaters, NoCats, NoObjects]);
lReport.Add(''); lReport.Add('');
// get memory for R and set to zero // Get memory for R and set to zero
SetLength(R, NoRaters+1, NoCats+1, NoObjects+1); SetLength(R, NoRaters+1, NoCats+1, NoObjects+1);
for i := 0 to NoRaters - 1 do for i := 0 to NoRaters - 1 do
for k := 0 to NoCats - 1 do for k := 0 to NoCats - 1 do
for l := 0 to NoObjects - 1 do for l := 0 to NoObjects - 1 do
R[i,k,l] := 0; R[i, k, l] := 0;
// get memory for average_frequency // Get memory for average_frequency
SetLength(average_frequency, NoCats+1); SetLength(average_frequency, NoCats+1);
for k := 0 to NoCats - 1 do for k := 0 to NoCats - 1 do
average_frequency[k] := 0.0; average_frequency[k] := 0.0;
// read data and store in R // Read data and store in R
for i := 1 to NoCases do for i := 1 to NoCases do
begin begin
rater := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[RaterCol, i]))); rater := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[RaterCol, i])));
@ -192,7 +178,7 @@ begin
R[rater-1, category-1, anobject-1] := 1; R[rater-1, category-1, anobject-1] := 1;
end; end;
//compute chance probability of agreement pchance for all raters // Compute chance probability of agreement pchance for all raters
pchance := 0.0; pchance := 0.0;
denom := compute_denom(R); denom := compute_denom(R);
for i := 0 to NoRaters - 1 do for i := 0 to NoRaters - 1 do
@ -226,7 +212,7 @@ begin
lReport.Add('PChance: %f', [pchance]); lReport.Add('PChance: %f', [pchance]);
// compute observed probability of agreement among all raters // Compute observed probability of agreement among all raters
num := 0.0; num := 0.0;
for k := 0 to NoCats - 1 do for k := 0 to NoCats - 1 do
for l := 0 to NoObjects - 1 do for l := 0 to NoObjects - 1 do
@ -244,49 +230,13 @@ begin
if (z > 0.0) then z := kappa / sqrt(z); if (z > 0.0) then z := kappa / sqrt(z);
lReport.Add('z for Kappa: %.3f with probability > %.3f', [z, 1.0-probz(z)]); lReport.Add('z for Kappa: %.3f with probability > %.3f', [z, 1.0-probz(z)]);
DisplayReport(lReport); FReportFrame.DisplayReport(lReport);
finally finally
lReport.Free; lReport.Free;
average_frequency := nil;
R := nil;
end; end;
end; end;
procedure TGenKappaFrm.FormActivate(Sender: TObject);
var
w: Integer;
begin
if FAutoSized then
exit;
w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]);
HelpBtn.Constraints.MinWidth := w;
ResetBtn.Constraints.MinWidth := w;
ComputeBtn.Constraints.MinWidth := w;
CloseBtn.Constraints.MinWidth := w;
Constraints.MinWidth := Width;
Constraints.MinHeight := Height;
FAutoSized := true;
end;
procedure TGenKappaFrm.FormCreate(Sender: TObject);
begin
Assert(OS3MainFrm <> nil);
end;
procedure TGenKappaFrm.FormShow(Sender: TObject);
begin
ResetBtnClick(self);
end;
procedure TGenKappaFrm.HelpBtnClick(Sender: TObject);
begin
if ContextHelpForm = nil then
Application.CreateForm(TContextHelpForm, ContextHelpForm);
ContextHelpForm.HelpMessage((Sender as TButton).Tag);
end;
function TGenKappaFrm.compute_term1(R: IntDyneCube; i, j, k: integer): double; function TGenKappaFrm.compute_term1(R: IntDyneCube; i, j, k: integer): double;
var var
@ -318,6 +268,7 @@ begin
result := (num_i * num_j) / (denom_i * denom_j); //((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; end;
function TGenKappaFrm.compute_term2(R: IntDyneCube; i, j, l: integer): double; function TGenKappaFrm.compute_term2(R: IntDyneCube; i, j, l: integer): double;
var var
sum_i, sum_j, k: integer; sum_i, sum_j, k: integer;
@ -334,9 +285,10 @@ begin
Result := sum_i * sum_j; Result := sum_i * sum_j;
end; end;
function TGenKappaFrm.compute_denom(R: IntDyneCube): double; function TGenKappaFrm.compute_denom(R: IntDyneCube): double;
var var
sum: IntDyneVec; sum: IntDyneVec = nil;
i, k, l: integer; i, k, l: integer;
begin begin
Result := 0; Result := 0;
@ -356,6 +308,7 @@ begin
sum := nil; sum := nil;
end; end;
function TGenKappaFrm.compute_partial_pchance(R: IntDyneCube; i, j: integer; function TGenKappaFrm.compute_partial_pchance(R: IntDyneCube; i, j: integer;
denom: double): double; denom: double): double;
var var
@ -377,6 +330,7 @@ begin
Result := 0.0; Result := 0.0;
end; end;
function TGenKappaFrm.compute_partial_pobs(R: IntDyneCube; k, l: integer): double; function TGenKappaFrm.compute_partial_pobs(R: IntDyneCube; k, l: integer): double;
var var
sum, i: integer; sum, i: integer;
@ -388,21 +342,22 @@ begin
Result := sum * (sum - 1); Result := sum * (sum - 1);
end; end;
{ Calculates the variance of Kappa { Calculates the variance of Kappa
R contains 1's or 0's for raters, categories and objects (row, col, slice) R contains 1's or 0's for raters, categories and objects (row, col, slice)
m is number of raters m is number of raters
n is number of subjects n is number of subjects
K1 is the number of categories } K1 is the number of categories }
function TGenKappaFrm.KappaVariance(R : IntDyneCube; n, m, K1: integer): double; function TGenKappaFrm.KappaVariance(R: IntDyneCube; n, m, K1: integer): double;
var var
xij, term1, term2: double; xij, term1, term2: double;
i, j, k: integer; i, j, k: integer;
pj: DblDyneVec; pj: DblDyneVec = nil;
begin begin
term1 := 0.0; term1 := 0.0;
term2 := 0.0; term2 := 0.0;
SetLength(pj,K1); SetLength(pj, K1);
for j := 0 to K1 - 1 do pj[j] := 0.0; for j := 0 to K1 - 1 do pj[j] := 0.0;
// get proportion of values in each category // get proportion of values in each category
@ -433,6 +388,7 @@ begin
pj := nil; pj := nil;
end; end;
procedure TGenKappaFrm.ObjInClick(Sender: TObject); procedure TGenKappaFrm.ObjInClick(Sender: TObject);
var var
index: integer; index: integer;
@ -446,6 +402,7 @@ begin
end; end;
end; end;
procedure TGenKappaFrm.ObjOutClick(Sender: TObject); procedure TGenKappaFrm.ObjOutClick(Sender: TObject);
begin begin
if ObjectEdit.Text <> '' then if ObjectEdit.Text <> '' then
@ -456,6 +413,7 @@ begin
end; end;
end; end;
procedure TGenKappaFrm.RaterInClick(Sender: TObject); procedure TGenKappaFrm.RaterInClick(Sender: TObject);
var var
index: integer; index: integer;
@ -469,6 +427,7 @@ begin
end; end;
end; end;
procedure TGenKappaFrm.RaterOutClick(Sender: TObject); procedure TGenKappaFrm.RaterOutClick(Sender: TObject);
begin begin
if RaterEdit.Text <> '' then if RaterEdit.Text <> '' then
@ -479,10 +438,29 @@ begin
end; end;
end; end;
procedure TGenKappaFrm.Reset;
var
i: integer;
begin
inherited;
CatEdit.Clear;
ObjectEdit.Clear;
RaterEdit.Clear;
VarList.Clear;
for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i, 0]);
UpdateBtnStates;
end;
procedure TGenKappaFrm.UpdateBtnStates; procedure TGenKappaFrm.UpdateBtnStates;
var var
lSelected: Boolean; lSelected: Boolean;
begin begin
inherited;
lSelected := AnySelected(VarList); lSelected := AnySelected(VarList);
CatIn.Enabled := lSelected and (CatEdit.Text = ''); CatIn.Enabled := lSelected and (CatEdit.Text = '');
@ -495,14 +473,33 @@ begin
RaterOut.Enabled := (RaterEdit.Text <> ''); RaterOut.Enabled := (RaterEdit.Text <> '');
end; end;
procedure TGenKappaFrm.VarListDblClick(Sender: TObject);
var
index: Integer;
s: String;
begin
index := VarList.ItemIndex;
if index > -1 then
begin
s := VarList.Items[index];
if CatEdit.Text = '' then
CatEdit.Text := s
else if ObjectEdit.Text = '' then
ObjectEdit.Text := s
else if RaterEdit.Text = '' then
RaterEdit.Text := s;
VarList.Items.Delete(index);
UpdateBtnStates;
end;
end;
procedure TGenKappaFrm.VarListSelectionChange(Sender: TObject; User: boolean); procedure TGenKappaFrm.VarListSelectionChange(Sender: TObject; User: boolean);
begin begin
UpdateBtnStates; UpdateBtnStates;
end; end;
initialization
{$I genkappaunit.lrs}
end. end.