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

LazStats: Inherit CaplanMeierUnit from TBasicStatsReportAndChartForm. Replace hand-made chart by TAChart.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7822 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-10-28 19:01:05 +00:00
parent 38db0c2fba
commit f000670847
7 changed files with 554 additions and 568 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
applications/lazstats/source/LazStats.lpi
View File

@@ -729,7 +729,7 @@
<Unit78> <Unit78>
<Filename Value="forms\analysis\nonparametric\exactunit.pas"/> <Filename Value="forms\analysis\nonparametric\exactunit.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<ComponentName Value="FisherFrm"/> <ComponentName Value="FisherForm"/>
<HasResources Value="True"/> <HasResources Value="True"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="ExactUnit"/> <UnitName Value="ExactUnit"/>
@@ -801,7 +801,7 @@
<Unit87> <Unit87>
<Filename Value="forms\analysis\nonparametric\kaplanmeierunit.pas"/> <Filename Value="forms\analysis\nonparametric\kaplanmeierunit.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<ComponentName Value="KaplanMeierFrm"/> <ComponentName Value="KaplanMeierForm"/>
<HasResources Value="True"/> <HasResources Value="True"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="KaplanMeierUnit"/> <UnitName Value="KaplanMeierUnit"/>

2
applications/lazstats/source/forms/analysis/nonparametric/exactunit.lfm
View File

@@ -1,4 +1,4 @@
inherited FisherFrm: TFisherFrm inherited FisherForm: TFisherForm
Left = 535 Left = 535
Height = 524 Height = 524
Top = 234 Top = 234

38
applications/lazstats/source/forms/analysis/nonparametric/exactunit.pas
View File

@@ -11,9 +11,9 @@ uses
type type
{ TFisherFrm } { TFisherForm }
TFisherFrm = class(TBasicStatsReportForm) TFisherForm = class(TBasicStatsReportForm)
AlphaEdit: TEdit; AlphaEdit: TEdit;
Label2: TLabel; Label2: TLabel;
Label5: TLabel; Label5: TLabel;
@@ -70,7 +70,7 @@ type
end; end;
var var
FisherFrm: TFisherFrm; FisherForm: TFisherForm;
implementation implementation
@@ -81,9 +81,9 @@ uses
Utils, GridProcs; Utils, GridProcs;
{ TFisherFrm } { TFisherForm }
procedure TFisherFrm.AdjustConstraints; procedure TFisherForm.AdjustConstraints;
begin begin
inherited; inherited;
ParamsPanel.Constraints.MinWidth := InputGrp.Width; ParamsPanel.Constraints.MinWidth := InputGrp.Width;
@@ -94,7 +94,7 @@ begin
end; end;
procedure TFisherFrm.ColInClick(Sender: TObject); procedure TFisherForm.ColInClick(Sender: TObject);
var var
index: integer; index: integer;
begin begin
@@ -108,7 +108,7 @@ begin
end; end;
procedure TFisherFrm.ColOutClick(Sender: TObject); procedure TFisherForm.ColOutClick(Sender: TObject);
begin begin
if ColEdit.Text <> '' then if ColEdit.Text <> '' then
begin begin
@@ -119,7 +119,7 @@ begin
end; end;
procedure TFisherFrm.Compute; procedure TFisherForm.Compute;
var var
i, j, row, col, caseRow, caseCol, A, B, C, D, largest: integer; i, j, row, col, caseRow, caseCol, A, B, C, D, largest: integer;
N, APlusB, APlusC, BPlusD, CPlusD, NoSelected, dep: integer; N, APlusB, APlusC, BPlusD, CPlusD, NoSelected, dep: integer;
@@ -337,7 +337,7 @@ begin
end; end;
procedure TFisherFrm.DepInClick(Sender: TObject); procedure TFisherForm.DepInClick(Sender: TObject);
var var
index: integer; index: integer;
begin begin
@@ -351,7 +351,7 @@ begin
end; end;
procedure TFisherFrm.DepOutClick(Sender: TObject); procedure TFisherForm.DepOutClick(Sender: TObject);
begin begin
if DepEdit.Text <> '' then if DepEdit.Text <> '' then
begin begin
@@ -362,7 +362,7 @@ begin
end; end;
procedure TFisherFrm.InputGrpClick(Sender: TObject); procedure TFisherForm.InputGrpClick(Sender: TObject);
begin begin
if InputGrp.ItemIndex = 3 then if InputGrp.ItemIndex = 3 then
begin begin
@@ -405,7 +405,7 @@ begin
end; end;
procedure TFisherFrm.PrintFisherTable(AList: TStrings; procedure TFisherForm.PrintFisherTable(AList: TStrings;
A, B, C, D: integer; P, SumP: double); A, B, C, D: integer; P, SumP: double);
begin begin
AList.Add('Contingency Table for Fisher Exact Test'); AList.Add('Contingency Table for Fisher Exact Test');
@@ -420,7 +420,7 @@ begin
end; end;
procedure TFisherFrm.Reset; procedure TFisherForm.Reset;
var var
i: integer; i: integer;
begin begin
@@ -452,7 +452,7 @@ begin
end; end;
procedure TFisherFrm.RowInClick(Sender: TObject); procedure TFisherForm.RowInClick(Sender: TObject);
var var
index: integer; index: integer;
begin begin
@@ -466,7 +466,7 @@ begin
end; end;
procedure TFisherFrm.RowOutClick(Sender: TObject); procedure TFisherForm.RowOutClick(Sender: TObject);
begin begin
if RowEdit.Text <> '' then if RowEdit.Text <> '' then
begin begin
@@ -477,7 +477,7 @@ begin
end; end;
function TFisherFrm.Validate(out AMsg: String; out AControl: TWinControl): boolean; function TFisherForm.Validate(out AMsg: String; out AControl: TWinControl): boolean;
var var
x: Double; x: Double;
n: Integer; n: Integer;
@@ -530,7 +530,7 @@ begin
end; end;
procedure TFisherFrm.VarListDblClick(Sender: TObject); procedure TFisherForm.VarListDblClick(Sender: TObject);
var var
index: Integer; index: Integer;
s: String; s: String;
@@ -551,13 +551,13 @@ begin
end; end;
procedure TFisherFrm.VarListSelectionChange(Sender: TObject; User: boolean); procedure TFisherForm.VarListSelectionChange(Sender: TObject; User: boolean);
begin begin
UpdateBtnStates; UpdateBtnStates;
end; end;
procedure TFisherFrm.UpdateBtnStates; procedure TFisherForm.UpdateBtnStates;
begin begin
inherited; inherited;

358
applications/lazstats/source/forms/analysis/nonparametric/kaplanmeierunit.lfm
View File

@@ -1,127 +1,42 @@
object KaplanMeierFrm: TKaplanMeierFrm inherited KaplanMeierForm: TKaplanMeierForm
Left = 596 Left = 596
Height = 406 Height = 400
Top = 239 Top = 239
Width = 505 Width = 879
HelpType = htKeyword HelpType = htKeyword
HelpKeyword = 'html/Kaplan-MeierSurvivalTest.htm' HelpKeyword = 'html/Kaplan-MeierSurvivalTest.htm'
AutoSize = True
Caption = 'Kaplan-Meier Survival Analysis' Caption = 'Kaplan-Meier Survival Analysis'
ClientHeight = 406 ClientHeight = 400
ClientWidth = 505 ClientWidth = 879
OnActivate = FormActivate inherited ParamsPanel: TPanel
OnCreate = FormCreate Height = 384
OnShow = FormShow Width = 363
Position = poMainFormCenter ClientHeight = 384
LCLVersion = '2.1.0.0' ClientWidth = 363
object ResetBtn: TButton inherited CloseBtn: TButton
AnchorSideRight.Control = ComputeBtn Left = 308
AnchorSideBottom.Control = Owner Top = 359
AnchorSideBottom.Side = asrBottom
Left = 288
Height = 25
Top = 373
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 end
object ComputeBtn: TButton inherited ComputeBtn: TButton
AnchorSideRight.Control = CloseBtn Left = 224
AnchorSideBottom.Control = Owner Top = 359
AnchorSideBottom.Side = asrBottom
Left = 350
Height = 25
Top = 373
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 end
object CloseBtn: TButton inherited ResetBtn: TButton
AnchorSideRight.Control = Owner Left = 162
AnchorSideRight.Side = asrBottom Top = 359
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 438
Height = 25
Top = 373
Width = 55
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 12
BorderSpacing.Top = 8
BorderSpacing.Right = 12
BorderSpacing.Bottom = 8
Caption = 'Close'
ModalResult = 11
TabOrder = 4
end end
object HelpBtn: TButton inherited HelpBtn: TButton
Tag = 127 Tag = 127
AnchorSideRight.Control = ResetBtn Left = 103
AnchorSideBottom.Control = Owner Top = 359
AnchorSideBottom.Side = asrBottom
Left = 229
Height = 25
Top = 373
Width = 51
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 12
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Help'
OnClick = HelpBtnClick
TabOrder = 1
end end
object Bevel1: TBevel inherited ButtonBevel: TBevel
AnchorSideLeft.Control = Owner Top = 343
AnchorSideRight.Control = Owner Width = 363
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = CloseBtn
Left = 0
Height = 8
Top = 357
Width = 505
Anchors = [akLeft, akRight, akBottom]
Shape = bsBottomLine
end end
object Panel1: TPanel object Label1: TLabel[5]
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = ParamsPanel
AnchorSideTop.Control = Owner AnchorSideTop.Control = ParamsPanel
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Bevel1
Left = 8
Height = 349
Top = 8
Width = 489
Anchors = [akTop, akLeft, akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BevelOuter = bvNone
ClientHeight = 349
ClientWidth = 489
TabOrder = 0
object Label1: TLabel
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = Panel1
Left = 0 Left = 0
Height = 15 Height = 15
Top = 0 Top = 0
@@ -129,242 +44,219 @@ object KaplanMeierFrm: TKaplanMeierFrm
Caption = 'Available Variables' Caption = 'Available Variables'
ParentColor = False ParentColor = False
end end
object Label2: TLabel object TimeVarLabel: TLabel[6]
AnchorSideLeft.Control = TimeEdit AnchorSideLeft.Control = TimeVarEdit
AnchorSideBottom.Control = TimeEdit AnchorSideBottom.Control = TimeVarEdit
Left = 266 Left = 201
Height = 15 Height = 15
Top = 25 Top = 133
Width = 70 Width = 70
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 2 BorderSpacing.Bottom = 2
Caption = 'Time Variable' Caption = 'Time Variable'
ParentColor = False ParentColor = False
end end
object Label3: TLabel object EventVarLabel: TLabel[7]
AnchorSideLeft.Control = EventEdit AnchorSideLeft.Control = EventVarEdit
AnchorSideBottom.Control = EventEdit AnchorSideBottom.Control = EventVarEdit
Left = 266 Left = 201
Height = 30 Height = 30
Top = 108 Top = 210
Width = 140 Width = 140
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 2 BorderSpacing.Bottom = 2
Caption = 'Event vs Censored Variable'#13#10'(Event = 1, Censored = 2)' Caption = 'Event vs Censored Variable'#13#10'(Event = 1, Censored = 2)'
ParentColor = False ParentColor = False
end end
object Label5: TLabel object GroupVarLabel: TLabel[8]
AnchorSideLeft.Control = GroupEdit AnchorSideLeft.Control = GroupVarEdit
AnchorSideBottom.Control = GroupEdit AnchorSideBottom.Control = GroupVarEdit
Left = 266 Left = 201
Height = 30 Height = 30
Top = 194 Top = 42
Width = 160 Width = 160
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 2 BorderSpacing.Bottom = 2
Caption = 'Group Variable (if 2 groups)'#13#10'(Experimental = 1, Control =2)' Caption = 'Group Variable (if 2 groups)'#13#10'(Experimental = 1, Control =2)'
ParentColor = False ParentColor = False
end end
object VarList: TListBox object VarList: TListBox[9]
AnchorSideLeft.Control = Panel1 AnchorSideLeft.Control = ParamsPanel
AnchorSideTop.Control = Label1 AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = TimeInBtn AnchorSideRight.Control = TimeInBtn
AnchorSideBottom.Control = Panel1 AnchorSideBottom.Control = ButtonBevel
AnchorSideBottom.Side = asrBottom
Left = 0 Left = 0
Height = 332 Height = 326
Top = 17 Top = 17
Width = 222 Width = 161
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 TimeInBtn: TBitBtn object TimeInBtn: TBitBtn[10]
AnchorSideLeft.Control = Panel1 AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = VarList AnchorSideTop.Control = GroupOutBtn
Left = 230 AnchorSideTop.Side = asrBottom
Left = 167
Height = 28 Height = 28
Top = 17 Top = 125
Width = 28 Width = 28
BorderSpacing.Top = 24
Images = MainDataModule.ImageList Images = MainDataModule.ImageList
ImageIndex = 1 ImageIndex = 1
OnClick = TimeInBtnClick OnClick = TimeInBtnClick
Spacing = 0 Spacing = 0
TabOrder = 1 TabOrder = 5
end end
object TimeOutBtn: TBitBtn object TimeOutBtn: TBitBtn[11]
AnchorSideLeft.Control = Panel1 AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = TimeInBtn AnchorSideTop.Control = TimeInBtn
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 230 Left = 167
Height = 28 Height = 28
Top = 49 Top = 157
Width = 28 Width = 28
BorderSpacing.Top = 4 BorderSpacing.Top = 4
Images = MainDataModule.ImageList Images = MainDataModule.ImageList
ImageIndex = 0 ImageIndex = 0
OnClick = TimeOutBtnClick OnClick = TimeOutBtnClick
Spacing = 0 Spacing = 0
TabOrder = 2 TabOrder = 6
end end
object EventInBtn: TBitBtn object EventInBtn: TBitBtn[12]
AnchorSideLeft.Control = Panel1 AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = TimeOutBtn AnchorSideTop.Control = TimeOutBtn
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 230 Left = 167
Height = 28 Height = 28
Top = 105 Top = 209
Width = 28 Width = 28
BorderSpacing.Top = 28 BorderSpacing.Top = 24
Images = MainDataModule.ImageList Images = MainDataModule.ImageList
ImageIndex = 1 ImageIndex = 1
OnClick = EventInBtnClick OnClick = EventInBtnClick
Spacing = 0 Spacing = 0
TabOrder = 4 TabOrder = 7
end end
object EventOutBtn: TBitBtn object EventOutBtn: TBitBtn[13]
AnchorSideLeft.Control = Panel1 AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = EventInBtn AnchorSideTop.Control = EventInBtn
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 230 Left = 167
Height = 28 Height = 28
Top = 137 Top = 241
Width = 28 Width = 28
BorderSpacing.Top = 4 BorderSpacing.Top = 4
Images = MainDataModule.ImageList Images = MainDataModule.ImageList
ImageIndex = 0 ImageIndex = 0
OnClick = EventOutBtnClick OnClick = EventOutBtnClick
Spacing = 0 Spacing = 0
TabOrder = 5 TabOrder = 8
end end
object GroupInBtn: TBitBtn object GroupInBtn: TBitBtn[14]
AnchorSideLeft.Control = Panel1 AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = EventOutBtn AnchorSideTop.Control = VarList
AnchorSideTop.Side = asrBottom Left = 167
Left = 230
Height = 28 Height = 28
Top = 189 Top = 41
Width = 28 Width = 28
BorderSpacing.Top = 24 BorderSpacing.Top = 24
Images = MainDataModule.ImageList Images = MainDataModule.ImageList
ImageIndex = 1 ImageIndex = 1
OnClick = GroupInBtnClick OnClick = GroupInBtnClick
Spacing = 0 Spacing = 0
TabOrder = 7 TabOrder = 9
end end
object GroupOutBtn: TBitBtn object GroupOutBtn: TBitBtn[15]
AnchorSideLeft.Control = Panel1 AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = GroupInBtn AnchorSideTop.Control = GroupInBtn
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 230 Left = 167
Height = 28 Height = 28
Top = 221 Top = 73
Width = 28 Width = 28
BorderSpacing.Top = 4 BorderSpacing.Top = 4
Images = MainDataModule.ImageList Images = MainDataModule.ImageList
ImageIndex = 0 ImageIndex = 0
OnClick = GroupOutBtnClick OnClick = GroupOutBtnClick
Spacing = 0 Spacing = 0
TabOrder = 8 TabOrder = 10
end end
object TimeEdit: TEdit object TimeVarEdit: TEdit[16]
AnchorSideLeft.Control = TimeInBtn AnchorSideLeft.Control = TimeInBtn
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideRight.Control = Panel1 AnchorSideRight.Control = ParamsPanel
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = TimeOutBtn AnchorSideBottom.Control = TimeOutBtn
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 266 Left = 201
Height = 23 Height = 23
Top = 42 Top = 150
Width = 223 Width = 162
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 8 BorderSpacing.Left = 6
BorderSpacing.Bottom = 12 BorderSpacing.Bottom = 12
TabOrder = 3 TabOrder = 11
Text = 'TimeEdit' Text = 'TimeVarEdit'
end end
object EventEdit: TEdit object EventVarEdit: TEdit[17]
AnchorSideLeft.Control = EventInBtn AnchorSideLeft.Control = GroupInBtn
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideRight.Control = Panel1 AnchorSideRight.Control = ParamsPanel
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = EventOutBtn AnchorSideBottom.Control = EventOutBtn
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 266 Left = 201
Height = 23 Height = 23
Top = 140 Top = 242
Width = 223 Width = 162
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 8 BorderSpacing.Left = 6
BorderSpacing.Bottom = 2 BorderSpacing.Bottom = 4
TabOrder = 6 TabOrder = 12
Text = 'EventEdit' Text = 'EventVarEdit'
end end
object GroupEdit: TEdit object GroupVarEdit: TEdit[18]
AnchorSideLeft.Control = GroupInBtn AnchorSideLeft.Control = GroupInBtn
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideRight.Control = Panel1 AnchorSideTop.Control = GroupVarLabel
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = ParamsPanel
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = GroupOutBtn AnchorSideBottom.Control = GroupOutBtn
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 266 Left = 201
Height = 23 Height = 23
Top = 226 Top = 74
Width = 223 Width = 162
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 8 BorderSpacing.Left = 6
TabOrder = 9 BorderSpacing.Bottom = 4
Text = 'GroupEdit' TabOrder = 13
Text = 'GroupVarEdit'
end end
object GroupBox1: TGroupBox
AnchorSideLeft.Control = GroupOutBtn
AnchorSideTop.Control = GroupOutBtn
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Panel1
AnchorSideRight.Side = asrBottom
Left = 230
Height = 72
Top = 273
Width = 213
AutoSize = True
BorderSpacing.Top = 24
Caption = 'Options:'
ChildSizing.LeftRightSpacing = 12
ChildSizing.TopBottomSpacing = 6
ChildSizing.VerticalSpacing = 2
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 52
ClientWidth = 209
TabOrder = 10
object PlotChk: TCheckBox
Left = 12
Height = 19
Top = 6
Width = 185
Caption = 'Graph Survival Probabilities (%)'
TabOrder = 0
end end
object PrintChk: TCheckBox inherited ParamsSplitter: TSplitter
Left = 12 Left = 375
Height = 19 Height = 400
Top = 27 end
Width = 185 inherited PageControl: TPageControl
AutoSize = False Left = 384
Caption = 'Show Computation Results' Height = 384
Width = 487
ActivePage = ReportPage
TabIndex = 0
TabOrder = 1 TabOrder = 1
end end
end
end
end end

557
applications/lazstats/source/forms/analysis/nonparametric/kaplanmeierunit.pas
View File

@@ -5,55 +5,47 @@ unit KaplanMeierUnit;
interface interface
uses uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
StdCtrls, ExtCtrls, Buttons, Clipbrd, StdCtrls, ExtCtrls, Buttons, Clipbrd,
MainUnit, Globals, FunctionsLib, OutputUnit, ContextHelpUnit; TASources, TAChartAxis,
MainUnit, Globals, FunctionsLib, BasicStatsReportAndChartFormUnit;
type type
{ TKaplanMeierFrm } { TKaplanMeierForm }
TKaplanMeierFrm = class(TForm) TKaplanMeierForm = class(TBasicStatsReportAndChartForm)
Bevel1: TBevel;
HelpBtn: TButton;
Panel1: TPanel;
ResetBtn: TButton;
ComputeBtn: TButton;
CloseBtn: TButton;
PlotChk: TCheckBox;
PrintChk: TCheckBox;
GroupBox1: TGroupBox;
TimeInBtn: TBitBtn; TimeInBtn: TBitBtn;
TimeOutBtn: TBitBtn; TimeOutBtn: TBitBtn;
EventInBtn: TBitBtn; EventInBtn: TBitBtn;
EventOutBtn: TBitBtn; EventOutBtn: TBitBtn;
GroupInBtn: TBitBtn; GroupInBtn: TBitBtn;
GroupOutBtn: TBitBtn; GroupOutBtn: TBitBtn;
TimeEdit: TEdit; TimeVarEdit: TEdit;
Label1: TLabel; Label1: TLabel;
Label2: TLabel; TimeVarLabel: TLabel;
Label3: TLabel; EventVarLabel: TLabel;
Label5: TLabel; GroupVarLabel: TLabel;
EventEdit: TEdit; EventVarEdit: TEdit;
GroupEdit: TEdit; GroupVarEdit: TEdit;
VarList: TListBox; VarList: TListBox;
procedure ComputeBtnClick(Sender: TObject);
procedure EventInBtnClick(Sender: TObject); procedure EventInBtnClick(Sender: TObject);
procedure EventOutBtnClick(Sender: TObject); procedure EventOutBtnClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure GroupInBtnClick(Sender: TObject); procedure GroupInBtnClick(Sender: TObject);
procedure GroupOutBtnClick(Sender: TObject); procedure GroupOutBtnClick(Sender: TObject);
procedure HelpBtnClick(Sender: TObject);
procedure ResetBtnClick(Sender: TObject);
procedure TimeInBtnClick(Sender: TObject); procedure TimeInBtnClick(Sender: TObject);
procedure TimeOutBtnClick(Sender: TObject); procedure TimeOutBtnClick(Sender: TObject);
procedure VarListDblClick(Sender: TObject);
procedure VarListSelectionChange(Sender: TObject; User: boolean); procedure VarListSelectionChange(Sender: TObject; User: boolean);
private private
{ private declarations } FExperimentalAxis: TChartAxis;
FAutoSized: Boolean; FControlAxis: TChartAxis;
procedure PlotXY(var Xpoints : IntDyneVec; FExperimentalSource: TListChartSource;
FControlSource: TListChartSource;
procedure PlotXY(const XPoints: IntDyneVec; const Y1Points, Y2Points: DblDyneVec;
const Dropped, Dropped2: IntDyneVec; N: Integer);
{
procedure PlotXY(var Xpoints : DblDyneVec;
var Ypoints : DblDyneVec; var Ypoints : DblDyneVec;
var Dropped : IntDyneVec; var Dropped : IntDyneVec;
var Dropped2 : IntDyneVec; var Dropped2 : IntDyneVec;
@@ -61,187 +53,205 @@ type
N : integer; N : integer;
XEdit : string; XEdit : string;
YEdit : string; YEdit : string;
curveno : integer); curveno : integer); }
procedure UpdateBtnStates; protected
procedure AdjustConstraints; override;
procedure Compute; override;
procedure UpdateBtnStates; override;
public public
{ public declarations } constructor Create(AOwner: TComponent); override;
procedure Reset; override;
end; end;
var var
KaplanMeierFrm: TKaplanMeierFrm; KaplanMeierForm: TKaplanMeierForm;
implementation implementation
{$R *.lfm}
uses uses
Math, BlankFrmUnit; Math,
TAChartUtils, TAChartAxisUtils, TACustomSeries,
GridProcs, {BlankFrmUnit, } MatrixUnit, ChartFrameUnit;
{ TKaplanMeierFrm } const
EXPERIMENTAL_CAPTION = 'Experimental';
CONTROL_CAPTION = 'Control';
procedure TKaplanMeierFrm.ResetBtnClick(Sender: TObject);
var { TKaplanMeierForm }
i: integer;
constructor TKaplanMeierForm.Create(AOwner: TComponent);
begin begin
VarList.Clear; inherited;
for i := 1 to NoVariables do {
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
TimeEdit.Text := '';
EventEdit.Text := '';
GroupEdit.Text := '';
UpdateBtnStates;
PlotChk.Checked := false;
PrintChk.Checked := false;
end;
procedure TKaplanMeierFrm.TimeInBtnClick(Sender: TObject);
var
i: integer;
begin
i := VarList.ItemIndex;
if (i > -1) and (TimeEdit.Text = '') then
begin
TimeEdit.Text := VarList.Items[i];
VarList.Items.Delete(i);
end;
UpdateBtnStates;
end;
procedure TKaplanMeierFrm.TimeOutBtnClick(Sender: TObject);
begin
if TimeEdit.Text <> '' then
begin
VarList.Items.Add(TimeEdit.Text);
TimeEdit.Text := '';
end;
UpdateBtnStates;
end;
procedure TKaplanMeierFrm.FormActivate(Sender: TObject);
var
w: Integer;
begin
if FAutoSized then
exit;
Panel1.Constraints.MinWidth := 2 * GroupBox1.Width + VarList.BorderSpacing.Left;
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 TKaplanMeierFrm.FormCreate(Sender: TObject);
begin
Assert(OS3MainFrm <> nil);
if BlankFrm = nil then if BlankFrm = nil then
Application.CreateForm(TBlankFrm, BlankFrm); Application.CreateForm(TBlankFrm, BlankFrm);
}
FChartFrame.SetTitle('SURVIVAL CURVE');
FChartFrame.SetXTitle('Time');
FChartFrame.SetYTitle('Probability');
FChartFrame.Chart.BottomAxis.Margin := 20;
FControlSource := TListChartSource.Create(FChartFrame.Chart);
FControlAxis := FChartFrame.Chart.AxisList.Add;
with FControlAxis do
begin
Alignment := calBottom;
Marks.Source := FControlSource;
Marks.Style := smsValue;
Marks.LabelFont.Color := DATA_COLORS[1];
Title.Caption := CONTROL_CAPTION;
Title.Visible := true;
Title.LabelFont.Color := DATA_COLORS[1];
AxisPen.Color := DATA_COLORS[1];
AxisPen.Visible := true;
Grid.Visible := false;
TickLength := 0;
Index := 0;
end;
FExperimentalSource := TListChartSource.Create(FChartFrame.Chart);
FExperimentalAxis := FChartFrame.Chart.AxisList.Add;
with FExperimentalAxis do
begin
Alignment := calBottom;
Marks.Source := FExperimentalSource;
Marks.Style := smsValue;
Marks.LabelFont.Color := DATA_COLORS[0];
Title.Caption := EXPERIMENTAL_CAPTION;
Title.Visible := true;
Title.LabelFont.Color := DATA_COLORS[0];
AxisPen.Color := DATA_COLORS[0];
AxisPen.Visible := true;
Grid.Visible := false;
TickLength := 0;
Margin := 20;
Index := 1;
end;
PageControl.ActivePageIndex := 0;
end; end;
procedure TKaplanMeierFrm.FormShow(Sender: TObject);
procedure TKaplanMeierForm.AdjustConstraints;
begin begin
ResetBtnClick(self); inherited;
ParamsPanel.Constraints.MinWidth := Max(
4*CloseBtn.Width + 3*CloseBtn.BorderSpacing.Left,
GroupVarLabel.Width*2 + GroupInBtn.Width + 2*VarList.BorderSpacing.Right
);
ParamsPanel.Constraints.MinHeight := EventOutBtn.Top + EventOutBtn.Height +
VarList.BorderSpacing.Bottom +
ButtonBevel.Height + CloseBtn.BorderSpacing.Top + CloseBtn.Height;
end; end;
procedure TKaplanMeierFrm.GroupInBtnClick(Sender: TObject);
procedure TKaplanMeierForm.GroupInBtnClick(Sender: TObject);
var var
i: integer; i: integer;
begin begin
i := VarList.ItemIndex; i := VarList.ItemIndex;
if (i > -1) and (GroupEdit.Text = '') then if (i > -1) and (GroupVarEdit.Text = '') then
begin begin
GroupEdit.Text := VarList.Items[i]; GroupVarEdit.Text := VarList.Items[i];
VarList.Items.Delete(i); VarList.Items.Delete(i);
end; end;
UpdateBtnStates; UpdateBtnStates;
end; end;
procedure TKaplanMeierFrm.GroupOutBtnClick(Sender: TObject);
procedure TKaplanMeierForm.GroupOutBtnClick(Sender: TObject);
begin begin
if GroupEdit.Text <> '' then if GroupVarEdit.Text <> '' then
begin begin
VarList.Items.Add(GroupEdit.Text); VarList.Items.Add(GroupVarEdit.Text);
GroupEdit.Text := ''; GroupVarEdit.Text := '';
end; end;
UpdateBtnStates; UpdateBtnStates;
end; end;
procedure TKaplanMeierFrm.HelpBtnClick(Sender: TObject);
begin
if ContextHelpForm = nil then
Application.CreateForm(TContextHelpForm, ContextHelpForm);
ContextHelpForm.HelpMessage((Sender as TButton).tag);
end;
procedure TKaplanMeierFrm.EventInBtnClick(Sender: TObject); procedure TKaplanMeierForm.EventInBtnClick(Sender: TObject);
var var
i: integer; i: integer;
begin begin
i := VarList.ItemIndex; i := VarList.ItemIndex;
if (i > -1) and (EventEdit.Text = '') then if (i > -1) and (EventVarEdit.Text = '') then
begin begin
EventEdit.Text := VarList.Items[i]; EventVarEdit.Text := VarList.Items[i];
VarList.Items.Delete(i); VarList.Items.Delete(i);
end; end;
UpdateBtnStates; UpdateBtnStates;
end; end;
procedure TKaplanMeierFrm.EventOutBtnClick(Sender: TObject); procedure TKaplanMeierForm.EventOutBtnClick(Sender: TObject);
begin begin
if EventEdit.Text <> '' then if EventVarEdit.Text <> '' then
begin begin
VarList.Items.Add(EventEdit.Text); VarList.Items.Add(EventVarEdit.Text);
EventEdit.Text := ''; EventVarEdit.Text := '';
end; end;
UpdateBtnStates; UpdateBtnStates;
end; end;
procedure TKaplanMeierFrm.ComputeBtnClick(Sender: TObject); procedure TKaplanMeierForm.Compute;
var var
TwoGroups : boolean; TwoGroups : boolean;
Size1, Size2, TotalSize, NoDeaths, ThisTime: integer; Size1, Size2, TotalSize, NoDeaths, ThisTime: integer;
mintime, maxtime, tempint, nopoints, tempvalue : integer; minTime, maxTime, tempInt, noPoints, tempValue: integer;
NoCensored, nocats, i, j, k, icase, oldtime, pos, first, last : integer; NoCensored, noCats, i, j, k, icase, oldtime, pos, first, last : integer;
noinexp, noincntrl, count, TimeCol, DeathsCol: integer; noinexp, noincntrl, count, TimeCol, DeathsCol: integer;
GroupCol : integer; GroupCol : integer;
cumprop, proportion, term1, term2, term3 : double; cumprop, proportion, term1, term2, term3 : double;
E1, E2, O1, O2, Chisquare, ProbChi, Risk, LogRisk, SELogRisk : double; E1, E2, O1, O2, Chisquare, ProbChi, Risk, LogRisk, SELogRisk : double;
HiConf, LowConf, HiLogLevel, LowLogLevel, lastexp, lastctr : double; HiConf, LowConf, HiLogLevel, LowLogLevel, lastexp, lastctr : double;
TimePlot, Dropped, Dropped2, Time, AtRisk, Dead, SurvivalTimes : IntDyneVec; TimePlot: IntDyneVec = nil;
ExpCnt, CntrlCnt, TotalatRisk, ExpatRisk, CntrlatRisk : IntDyneVec; Dropped: IntDyneVec = nil;
Deaths, Group, Censored : IntDyneVec; Dropped2: IntDyneVec = nil;
ProbPlot, ProbPlot2, CondProb, ExpProp, CntrlProp : DblDyneVec; Time: IntDyneVec = nil;
CumPropExp, CumPropCntrl : DblDyneVec; AtRisk: IntDyneVec = nil;
TimeLabel, GroupLabel, DeathsLabel : string; Dead: IntDyneVec = nil;
SurvivalTimes: IntDyneVec = nil;
ExpCnt: IntDyneVec = nil;
CntrlCnt: IntDyneVec = nil;
TotalatRisk: IntDyneVec = nil;
ExpatRisk: IntDyneVec = nil;
CntrlatRisk: IntDyneVec = nil;
Deaths: IntDyneVec = nil;
Group: IntDyneVec = nil;
Censored: IntDyneVec = nil;
ProbPlot: DblDyneVec = nil;
ProbPlot2: DblDyneVec = nil;
CondProb: DblDyneVec = nil;
ExpProp: DblDyneVec = nil;
CntrlProp: DblDyneVec = nil;
CumPropExp: DblDyneVec = nil;
CumPropCntrl: DblDyneVec = nil;
TimeLabel, GroupLabel, DeathsLabel: string;
lReport: TStrings; lReport: TStrings;
begin begin
// get variable columns and labels // get variable columns and labels
TimeLabel := TimeEdit.Text; TimeLabel := TimeVarEdit.Text;
GroupLabel := GroupEdit.Text; GroupLabel := GroupVarEdit.Text;
DeathsLabel := EventEdit.Text; DeathsLabel := EventVarEdit.Text;
TimeCol := 0;
DeathsCol := 0;
GroupCol := 0;
for i := 1 to NoVariables do
begin
if (TimeLabel = OS3MainFrm.DataGrid.Cells[i,0]) then TimeCol := i;
if (DeathsLabel = OS3MainFrm.DataGrid.Cells[i,0]) then DeathsCol := i;
if (GroupLabel = OS3MainFrm.DataGrid.Cells[i,0]) then GroupCol := i;
end;
if (TimeCol = 0) or (DeathsCol = 0) then TimeCol := GetVariableIndex(OS3MainFrm.DataGrid, TimeVarEdit.Text);
DeathsCol := GetVariableIndex(OS3MainFrm.DataGrid, EventVarEdit.Text);
GroupCol := GetVariableIndex(OS3MainFrm.DataGrid, GroupVarEdit.Text);
if (TimeCol = -1) or (DeathsCol = -1) then
begin begin
MessageDlg('One or more variables not selected.', mtError, [mbOK], 0); MessageDlg('One or more variables not selected.', mtError, [mbOK], 0);
exit; exit;
end; end;
if (GroupEdit.Text = '') then if (GroupVarEdit.Text = '') then
begin begin
TwoGroups := false; TwoGroups := false;
Size1 := NoCases; Size1 := NoCases;
@@ -255,7 +265,8 @@ begin
begin begin
if (StrToInt(OS3MainFrm.DataGrid.Cells[GroupCol,i]) = 1) then if (StrToInt(OS3MainFrm.DataGrid.Cells[GroupCol,i]) = 1) then
Size1 := Size1 + 1 Size1 := Size1 + 1
else Size2 := Size2 + 1; else
Size2 := Size2 + 1;
end; end;
end; end;
@@ -321,23 +332,17 @@ begin
begin begin
if (SurvivalTimes[i] > SurvivalTimes[j]) then if (SurvivalTimes[i] > SurvivalTimes[j]) then
begin begin
tempint := SurvivalTimes[i]; Exchange(SurvivalTimes[i], SurvivalTimes[j]);
SurvivalTimes[i] := SurvivalTimes[j]; Exchange(Censored[i], Censored[j]);
SurvivalTimes[j] := tempint; Exchange(Deaths[i], Deaths[j]);
tempint := Censored[i];
Censored[i] := Censored[j];
Censored[j] := tempint;
tempint := Deaths[i];
Deaths[i] := Deaths[j];
Deaths[j] := tempint;
end; end;
end; end;
end; end;
// get number censored in each time slot // get number censored in each time slot
nopoints := maxtime + 1; nopoints := maxtime + 1;
SetLength(Dropped,nopoints+2); SetLength(Dropped, nopoints+2);
SetLength(Dropped2,nopoints+2); SetLength(Dropped2, nopoints+2);
for j := 0 to nopoints do for j := 0 to nopoints do
begin begin
Dropped[j] := 0; Dropped[j] := 0;
@@ -452,6 +457,13 @@ begin
Dropped[0] := 0; Dropped[0] := 0;
CondProb[0] := 0.0; CondProb[0] := 0.0;
for i := 1 to nocats do
begin
AtRisk[i] := AtRisk[i-1] - Dead[i-1] - Dropped[i-1];
CondProb[i-1] := 1.0 - Dead[i-1] / AtRisk[i-1];
end;
(*
lReport := TStringList.Create; lReport := TStringList.Create;
try try
lReport.Add(' Time Censored Dead At Risk Probability'); lReport.Add(' Time Censored Dead At Risk Probability');
@@ -461,11 +473,12 @@ begin
CondProb[i-1] := 1.0 - Dead[i-1] / AtRisk[i-1]; CondProb[i-1] := 1.0 - Dead[i-1] / AtRisk[i-1];
end; end;
for i := 0 to nocats do for i := 0 to nocats do
lReport.Add(' %3d %3d %3d %3d %6.3f', [Time[i],Dropped[i],Dead[i],AtRisk[i],CondProb[i]]); lReport.Add(' %3d %3d %3d %3d %6.3f', [Time[i], Dropped[i], Dead[i], AtRisk[i], CondProb[i]]);
DisplayReport(lReport); DisplayReport(lReport);
finally finally
lReport.Free; lReport.Free;
end; end;
*)
// Get cumulative proportions // Get cumulative proportions
for i := 0 to nocats do for i := 0 to nocats do
@@ -489,13 +502,21 @@ begin
lReport.Add(' %4d %4d %4d %4d %7.4f %7.4f', [ lReport.Add(' %4d %4d %4d %4d %7.4f %7.4f', [
Time[i], AtRisk[i], Dropped[i], Deaths[i], CondProb[i], CumPropExp[i] Time[i], AtRisk[i], Dropped[i], Deaths[i], CondProb[i], CumPropExp[i]
]); ]);
DisplayReport(lReport);
lReport.Add('');
lReport.Add(DIVIDER_AUTO);
lReport.Add('');
lReport.Add(' Time Censored Dead At Risk Probability');
for i := 0 to nocats do
lReport.Add(' %3d %3d %3d %3d %6.3f', [Time[i], Dropped[i], Dead[i], AtRisk[i], CondProb[i]]);
FReportFrame.DisplayReport(lReport);
finally finally
lReport.Free; lReport.Free;
end; end;
if PlotChk.Checked then // plot Y := cumulative proportion surviving, x := time // Plot X = Time, Y = cumulative proportion surviving
begin
// Get points to plot // Get points to plot
nopoints := maxtime + 1; nopoints := maxtime + 1;
SetLength(TimePlot,nocats+2); SetLength(TimePlot,nocats+2);
@@ -506,16 +527,10 @@ begin
TimePlot[j] := Time[j]; TimePlot[j] := Time[j];
ProbPlot[j] := CumPropExp[j]; ProbPlot[j] := CumPropExp[j];
end; end;
BlankFrm.Show; PlotXY(TimePlot, ProbPlot, nil, Dropped, Dropped, NoCats);
PlotXY(TimePlot, ProbPlot, Dropped, Dropped2, maxtime, 0, 1.0, 0.0, nocats, 'TIME', 'PROBABILITY', 1); // BlankFrm.Show;
end; // end if graph1 // PlotXY(TimePlot, ProbPlot, Dropped, Dropped2, maxtime, 0, 1.0, 0.0, nocats, 'TIME', 'PROBABILITY', 1);
ProbPlot := nil;
TimePlot := nil;
CondProb := nil;
Dead := nil;
AtRisk := nil;
Time := nil;
end // end if not two groups end // end if not two groups
//============================================================================// //============================================================================//
else // Experimental and control groups else // Experimental and control groups
@@ -558,18 +573,10 @@ begin
begin begin
if (SurvivalTimes[i] > SurvivalTimes[j]) then if (SurvivalTimes[i] > SurvivalTimes[j]) then
begin begin
tempint := SurvivalTimes[i]; Exchange(SurvivalTimes[i], SurvivalTimes[j]);
SurvivalTimes[i] := SurvivalTimes[j]; Exchange(Censored[i], Censored[j]);
SurvivalTimes[j] := tempint; Exchange(Deaths[i], Deaths[j]);
tempint := Censored[i]; Exchange(Group[i], Group[j]);
Censored[i] := Censored[j];
Censored[j] := tempint;
tempint := Deaths[i];
Deaths[i] := Deaths[j];
Deaths[j] := tempint;
tempint := Group[i];
Group[i] := Group[j];
Group[j] := tempint;
end; end;
end; end;
end; end;
@@ -595,15 +602,9 @@ begin
begin begin
if (Deaths[j] < Deaths[k] ) then // swap if (Deaths[j] < Deaths[k] ) then // swap
begin begin
tempint := Censored[j]; Exchange(Censored[j], Censored[k]);
Censored[j] := Censored[k]; Exchange(Deaths[j], Deaths[k]);
Censored[k] := tempint; Exchange(Group[j], Group[k]);
tempint := Deaths[j];
Deaths[j] := Deaths[k];
Deaths[k] := tempint;
tempint := Group[j];
Group[j] := Group[k];
Group[k] := tempint;
end; end;
end; // next k end; // next k
end; // next j end; // next j
@@ -782,7 +783,7 @@ begin
end; end;
// Print Results // Print Results
if (TwoGroups and PrintChk.Checked) then // both experimental and control groups if TwoGroups then // both experimental and control groups
begin begin
lReport := TStringList.Create; lReport := TStringList.Create;
try try
@@ -837,9 +838,10 @@ begin
// Plot data output // Plot data output
lReport.Add(''); lReport.Add('');
lReport.Add('============================================================================'); lReport.Add(DIVIDER_AUTO);
lReport.Add(''); lReport.Add('');
lReport.Add('EXPERIMENTAL GROUP CUMULATIVE PROBABILITY'); lReport.Add('EXPERIMENTAL GROUP CUMULATIVE PROBABILITY');
lReport.Add('');
lReport.Add('CASE TIME DEATHS CENSORED CUM.PROB.'); lReport.Add('CASE TIME DEATHS CENSORED CUM.PROB.');
for i := 1 to NoCases do for i := 1 to NoCases do
if (Group[i] = 1) then if (Group[i] = 1) then
@@ -847,9 +849,10 @@ begin
i, SurvivalTimes[i], Deaths[i], Censored[i], CumPropExp[i] i, SurvivalTimes[i], Deaths[i], Censored[i], CumPropExp[i]
]); ]);
lReport.Add(''); lReport.Add('');
lReport.Add('============================================================================'); lReport.Add(DIVIDER_AUTO);
lReport.Add(''); lReport.Add('');
lReport.Add('CONTROL GROUP CUMULATIVE PROBABILITY'); lReport.Add('CONTROL GROUP CUMULATIVE PROBABILITY');
lReport.Add('');
lReport.Add('CASE TIME DEATHS CENSORED CUM.PROB.'); lReport.Add('CASE TIME DEATHS CENSORED CUM.PROB.');
for i := 1 to NoCases do for i := 1 to NoCases do
if (Group[i] = 2) then if (Group[i] = 2) then
@@ -858,18 +861,17 @@ begin
]); ]);
lReport.Add(''); lReport.Add('');
DisplayReport(lReport); FReportFrame.DisplayReport(lReport);
finally finally
lReport.Free; lReport.Free;
end; end;
end; // if 2 groups and printit end; // if 2 groups and printit
if PlotChk.Checked then // plot cumulative proportion surviving (Y) against time (X) // Plot cumulative proportion surviving (Y) against time (X)
begin
nopoints := maxtime + 1; nopoints := maxtime + 1;
SetLength(TimePlot,nopoints+2); SetLength(TimePlot, nopoints+2);
SetLength(ProbPlot,nopoints+2); SetLength(ProbPlot, nopoints+2);
SetLength(ProbPlot2,nopoints+2); SetLength(ProbPlot2, nopoints+2);
ProbPlot[0] := 1.0; ProbPlot[0] := 1.0;
ProbPlot2[0] := 1.0; ProbPlot2[0] := 1.0;
lastexp := 1.0; lastexp := 1.0;
@@ -908,46 +910,61 @@ begin
end; end;
end; end;
BlankFrm.Image1.Canvas.Clear; PlotXY(TimePlot, ProbPlot, ProbPlot2, Dropped, Dropped2, NoPoints);
BlankFrm.Show; // BlankFrm.Image1.Canvas.Clear;
PlotXY(TimePlot, ProbPlot, Dropped, Dropped2, maxtime, 0, 1.0, 0.0, nopoints, 'TIME', 'PROBABILITY', 1); // BlankFrm.Show;
PlotXY(TimePlot, ProbPlot2, Dropped, Dropped2, maxtime, 0, 1.0, 0.0, nopoints, 'TIME', 'PROBABILITY', 2); // PlotXY(TimePlot, ProbPlot, Dropped, Dropped2, maxtime, 0, 1.0, 0.0, nopoints, 'TIME', 'PROBABILITY', 1);
// PlotXY(TimePlot, ProbPlot2, Dropped, Dropped2, maxtime, 0, 1.0, 0.0, nopoints, 'TIME', 'PROBABILITY', 2);
ProbPlot2 := nil;
ProbPlot := nil;
TimePlot := nil;
end; // if graph plot := 1
Dropped2 := nil;
Dropped := nil;
// clean up memory
Dropped2 := nil;
Dropped := nil;
CumPropCntrl := nil;
CumPropExp := nil;
Censored := nil;
Group := nil;
Deaths := nil;
CntrlProp := nil;
ExpProp := nil;
CntrlatRisk := nil;
ExpatRisk := nil;
TotalatRisk := nil;
CntrlCnt := nil;
ExpCnt := nil;
SurvivalTimes := nil;
end; end;
procedure TKaplanMeierFrm.PlotXY(var Xpoints: IntDyneVec;
procedure TKaplanMeierForm.PlotXY(const XPoints: IntDyneVec;
const Y1Points, Y2Points: DblDyneVec; const Dropped, Dropped2: IntDyneVec; N: Integer);
var
i: Integer;
ser: TChartSeries;
begin
// do not call FChartFrame.Clear which will delete the axis titles
FChartFrame.Chart.ClearSeries;
FExperimentalSource.Clear;
FControlSource.Clear;
if Y1Points <> nil then
begin
ser := FChartFrame.PlotXY(ptStairsYX, nil, nil, nil, nil, EXPERIMENTAL_CAPTION, DATA_COLORS[0]);
// add points manually due to overdimensioned data arrays...
for i := 0 to N-1 do
ser.AddXY(XPoints[i], Y1Points[i]);
end;
if Y2Points <> nil then
begin
ser := FChartFrame.PlotXY(ptStairsYX, nil, nil, nil, nil, CONTROL_CAPTION, DATA_COLORS[1]);
for i := 0 to N-1 do
ser.AddXY(XPoints[i], Y2Points[i]);
end;
if Dropped <> nil then
for i := 0 to N do
if Dropped[i] <> 0 then
FExperimentalSource.Add(XPoints[i], Dropped[i]);
if Dropped2 <> nil then
for i := 0 to N do
if Dropped2[i] <> 0 then
FControlSource.Add(XPoints[i], Dropped2[i]);
end;
(*
procedure TKaplanMeierForm.PlotXY(var Xpoints: DblDyneVec;
var Ypoints: DblDyneVec; var Dropped: IntDyneVec; var Dropped2: IntDyneVec; var Ypoints: DblDyneVec; var Dropped: IntDyneVec; var Dropped2: IntDyneVec;
Xmax, Xmin, Ymax, Ymin: double; N: integer; XEdit: string; YEdit: string; Xmax, Xmin, Ymax, Ymin: double; N: integer; XEdit: string; YEdit: string;
curveno: integer); curveno: integer);
var var
i, xpos, ypos, hleft, hright, vtop, vbottom, imagewide : integer; i, xpos, ypos, hleft, hright, vtop, vbottom, imagewide : integer;
vhi, hwide, offset, strhi, imagehi : integer; vhi, hwide, offset, strhi, imagehi : integer;
noxvalues, digitwidth, Xvalue, xvalincr, oldxpos : integer; noxvalues, digitwidth, xvalincr, oldxpos : integer;
valincr, Yvalue, value, oldypos, term1, term2, term3 : double; valincr, XValue, Yvalue, value, oldypos, term1, term2, term3 : double;
Title, outline : string; Title, outline : string;
label again, second; label again, second;
@@ -1119,12 +1136,57 @@ second: xpos := hleft;
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title);
end; end;
end; end;
*)
procedure TKaplanMeierFrm.UpdateBtnStates; procedure TKaplanMeierForm.Reset;
var
i: integer;
begin
inherited;
VarList.Clear;
for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
TimeVarEdit.Clear;
EventVarEdit.Clear;
GroupVarEdit.Clear;
UpdateBtnStates;
end;
procedure TKaplanMeierForm.TimeInBtnClick(Sender: TObject);
var
i: integer;
begin
i := VarList.ItemIndex;
if (i > -1) and (TimeVarEdit.Text = '') then
begin
TimeVarEdit.Text := VarList.Items[i];
VarList.Items.Delete(i);
end;
UpdateBtnStates;
end;
procedure TKaplanMeierForm.TimeOutBtnClick(Sender: TObject);
begin
if TimeVarEdit.Text <> '' then
begin
VarList.Items.Add(TimeVarEdit.Text);
TimeVarEdit.Text := '';
end;
UpdateBtnStates;
end;
procedure TKaplanMeierForm.UpdateBtnStates;
var var
lSelected: Boolean; lSelected: Boolean;
i: Integer; i: Integer;
begin begin
inherited;
lSelected := false; lSelected := false;
for i := 0 to VarList.Count-1 do for i := 0 to VarList.Count-1 do
if VarList.Selected[i] then if VarList.Selected[i] then
@@ -1132,21 +1194,42 @@ begin
lSelected := true; lSelected := true;
break; break;
end; end;
TimeInBtn.Enabled := lSelected and (TimeEdit.Text = '');
EventInBtn.Enabled := lSelected and (EventEdit.Text = ''); TimeInBtn.Enabled := lSelected and (TimeVarEdit.Text = '');
GroupInBtn.Enabled := lSelected and (GroupEdit.Text = ''); EventInBtn.Enabled := lSelected and (EventVarEdit.Text = '');
TimeOutBtn.Enabled := (TimeEdit.Text <> ''); GroupInBtn.Enabled := lSelected and (GroupVarEdit.Text = '');
EventOutBtn.Enabled := (EventEdit.Text <> ''); TimeOutBtn.Enabled := (TimeVarEdit.Text <> '');
GroupOutBtn.Enabled := (GroupEdit.Text <> ''); EventOutBtn.Enabled := (EventVarEdit.Text <> '');
GroupOutBtn.Enabled := (GroupVarEdit.Text <> '');
end; end;
procedure TKaplanMeierFrm.VarListSelectionChange(Sender: TObject; User: boolean);
procedure TKaplanMeierForm.VarListDblClick(Sender: TObject);
var
index: Integer;
s: String;
begin
index := VarList.ItemIndex;
if index > -1 then
begin
s := VarList.Items[index];
if GroupVarEdit.Text = '' then
GroupVarEdit.Text := s
else if TimeVarEdit.Text = '' then
TimeVarEdit.Text := s
else if EventVarEdit.Text = '' then
EventVarEdit.Text := s;
VarList.Items.Delete(index);
UpdateBtnStates;
end;
end;
procedure TKaplanMeierForm.VarListSelectionChange(Sender: TObject; User: boolean);
begin begin
UpdateBtnStates; UpdateBtnStates;
end; end;
initialization
{$I kaplanmeierunit.lrs}
end. end.

31
applications/lazstats/source/forms/mainunit.pas
View File

@@ -1805,6 +1805,17 @@ begin
PolyDIFFrm.ShowModal; PolyDIFFrm.ShowModal;
end; end;
// Menu "Analysis" > "Financial" > "Loan Amortization Schedule"
procedure TOS3MainFrm.mnuAnalysisFinancial_LoanAmortClick(Sender: TObject);
begin
if LoanItForm = nil then
Application.CreateForm(TLoanItForm, LoanItForm);
LoanItForm.Show;
end;
{ "Nonparametric" commands }
// Menu "Analysis" > "Nonparametric" > "Contingency Chi Square" // Menu "Analysis" > "Nonparametric" > "Contingency Chi Square"
procedure TOS3MainFrm.mnuAnalysisNonPar_ContingChiSqClick(Sender: TObject); procedure TOS3MainFrm.mnuAnalysisNonPar_ContingChiSqClick(Sender: TObject);
begin begin
@@ -1832,9 +1843,9 @@ end;
// Menu "Analysis" > "Nonparametric" > "Fisher's Exact Text" // Menu "Analysis" > "Nonparametric" > "Fisher's Exact Text"
procedure TOS3MainFrm.mnuAnalysisNonPar_FisherClick(Sender: TObject); procedure TOS3MainFrm.mnuAnalysisNonPar_FisherClick(Sender: TObject);
begin begin
if FisherFrm = nil then if FisherForm = nil then
Application.CreateForm(TFisherFrm, FisherFrm); Application.CreateForm(TFisherForm, FisherForm);
FisherFrm.ShowModal; FisherForm.Show;
end; end;
// Menu "Analysis" > "Nonparametric" > "Kendall's Coefficient of Concordance" // Menu "Analysis" > "Nonparametric" > "Kendall's Coefficient of Concordance"
@@ -1861,14 +1872,6 @@ begin
WilcoxonForm.Show; WilcoxonForm.Show;
end; end;
// Menu "Analysis" > "Financial" > "Loan Amortization Schedule"
procedure TOS3MainFrm.mnuAnalysisFinancial_LoanAmortClick(Sender: TObject);
begin
if LoanItForm = nil then
Application.CreateForm(TLoanItForm, LoanItForm);
LoanItForm.Show;
end;
// Menu "Analysis" > "Nonparametric" > "Cochran Q Test" // Menu "Analysis" > "Nonparametric" > "Cochran Q Test"
procedure TOS3MainFrm.mnuAnalysisNonPar_CochranClick(Sender: TObject); procedure TOS3MainFrm.mnuAnalysisNonPar_CochranClick(Sender: TObject);
begin begin
@@ -1912,9 +1915,9 @@ end;
// Menu "Analysis" > "Nonparametric" > "Kaplan-Meier Survival Analysis" // Menu "Analysis" > "Nonparametric" > "Kaplan-Meier Survival Analysis"
procedure TOS3MainFrm.mnuAnalysisNonPar_SurvivalClick(Sender: TObject); procedure TOS3MainFrm.mnuAnalysisNonPar_SurvivalClick(Sender: TObject);
begin begin
if KaplanMeierFrm = nil then if KaplanMeierForm = nil then
Application.CreateForm(TKaplanMeierFrm, KaplanMeierFrm); Application.CreateForm(TKaplanMeierForm, KaplanMeierForm);
KaplanMeierFrm.ShowModal; KaplanMeierForm.Show;
end; end;

14
applications/lazstats/source/frames/chartframeunit.pas
View File

@@ -24,7 +24,7 @@ const
type type
TPlotType = (ptLines, ptSymbols, ptLinesAndSymbols, ptBars, TPlotType = (ptLines, ptSymbols, ptLinesAndSymbols, ptBars,
ptArea); ptArea, ptStairsYX, ptStairsXY);
{ TChartFrame } { TChartFrame }
@@ -182,17 +182,25 @@ var
xval: Double; xval: Double;
begin begin
case AType of case AType of
ptLines, ptSymbols, ptLinesAndSymbols: ptLines, ptSymbols, ptLinesAndSymbols, ptStairsXY, ptStairsYX:
begin begin
Result := TLineSeries.Create(self); Result := TLineSeries.Create(self);
TLineSeries(Result).ShowPoints := AType in [ptSymbols, ptLinesAndSymbols]; TLineSeries(Result).ShowPoints := AType in [ptSymbols, ptLinesAndSymbols];
TLineSeries(Result).ShowLines := AType in [ptLines, ptLinesAndSymbols]; TLineSeries(Result).ShowLines := AType in [ptLines, ptLinesAndSymbols];
TLineSeries(Result).SeriesColor := AColor; TLineSeries(Result).SeriesColor := AColor;
if AType in [ptSymbols, ptLinesAndSymbols] then
case AType of
ptSymbols, ptLinesAndSymbols:
begin begin
TLineSeries(Result).Pointer.Brush.Color := AColor; TLineSeries(Result).Pointer.Brush.Color := AColor;
TLineSeries(Result).Pointer.Style := ASymbol; TLineSeries(Result).Pointer.Style := ASymbol;
end; end;
ptStairsXY:
TLineSeries(Result).LineType := ltStepXY;
ptStairsYX:
TLineSeries(Result).LineType := ltStepYX;
end;
if yErrorBars <> nil then if yErrorBars <> nil then
begin begin
TLineSeries(Result).YErrorBars.Visible := true; TLineSeries(Result).YErrorBars.Visible := true;