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

CoxRegUnit: Like others. Add coxreg.laz data file from OpenStat sample files.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7354 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-04-03 16:23:40 +00:00
parent efaf39fe38
commit 56bfa8c993
5 changed files with 585 additions and 465 deletions
Download Patch File Download Diff File Expand all files Collapse all files

71
applications/lazstats/data/coxreg.laz Normal file
View File

@ -0,0 +1,71 @@
11
3
VAR1
VARIABLE 1
5
F
3
99999
L
Time
VARIABLE 2
5
F
3
99999
L
Status
VARIABLE 3
4
F
2
99999
L
Case 0
VAR1
Time
Status
Case 1
50.00
1.00
0.00
Case 2
70.00
2.00
1.00
Case 3
45.00
3.00
0.00
Case 4
35.00
5.00
0.00
Case 5
62.00
7.00
1.00
Case 6
50.00
11.00
0.00
Case 7
45.00
4.00
0.00
Case 8
57.00
6.00
0.00
Case 9
32.00
8.00
0.00
Case 10
57.00
9.00
1.00
Case 11
60.00
10.00
1.00

BIN
applications/lazstats/docs/HelpNDoc/LazStats.hnd
View File

Binary file not shown.

BIN
applications/lazstats/docs/chm/LazStats.chm
View File

Binary file not shown.

103
applications/lazstats/source/forms/analysis/multiple_regression/coxregunit.lfm
View File

@ -2,11 +2,11 @@ object CoxRegFrm: TCoxRegFrm
Left = 457 Left = 457
Height = 401 Height = 401
Top = 291 Top = 291
Width = 432 Width = 424
AutoSize = True AutoSize = True
Caption = 'Cox Proportional Hazards Survival Regression' Caption = 'Cox Proportional Hazards Survival Regression'
ClientHeight = 401 ClientHeight = 401
ClientWidth = 432 ClientWidth = 424
OnActivate = FormActivate OnActivate = FormActivate
OnCreate = FormCreate OnCreate = FormCreate
OnShow = FormShow OnShow = FormShow
@ -27,7 +27,7 @@ object CoxRegFrm: TCoxRegFrm
object Label2: TLabel object Label2: TLabel
AnchorSideLeft.Control = BlockList AnchorSideLeft.Control = BlockList
AnchorSideTop.Control = Owner AnchorSideTop.Control = Owner
Left = 238 Left = 234
Height = 15 Height = 15
Top = 8 Top = 8
Width = 116 Width = 116
@ -38,7 +38,7 @@ object CoxRegFrm: TCoxRegFrm
object Label3: TLabel object Label3: TLabel
AnchorSideLeft.Control = DepVar AnchorSideLeft.Control = DepVar
AnchorSideBottom.Control = DepVar AnchorSideBottom.Control = DepVar
Left = 238 Left = 234
Height = 15 Height = 15
Top = 108 Top = 108
Width = 114 Width = 114
@ -50,7 +50,7 @@ object CoxRegFrm: TCoxRegFrm
object Label4: TLabel object Label4: TLabel
AnchorSideLeft.Control = StatusEdit AnchorSideLeft.Control = StatusEdit
AnchorSideBottom.Control = StatusEdit AnchorSideBottom.Control = StatusEdit
Left = 238 Left = 234
Height = 15 Height = 15
Top = 195 Top = 195
Width = 120 Width = 120
@ -64,11 +64,11 @@ object CoxRegFrm: TCoxRegFrm
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = GroupBox1 AnchorSideTop.Control = GroupBox1
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 195 Left = 219
Height = 15 Height = 15
Top = 296 Top = 296
Width = 117 Width = 117
BorderSpacing.Left = 16 BorderSpacing.Left = 40
Caption = 'Maximum Interations:' Caption = 'Maximum Interations:'
ParentColor = False ParentColor = False
end end
@ -81,7 +81,7 @@ object CoxRegFrm: TCoxRegFrm
Left = 8 Left = 8
Height = 221 Height = 221
Top = 26 Top = 26
Width = 186 Width = 182
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Top = 2 BorderSpacing.Top = 2
@ -90,13 +90,14 @@ object CoxRegFrm: TCoxRegFrm
Constraints.MinHeight = 220 Constraints.MinHeight = 220
ItemHeight = 0 ItemHeight = 0
MultiSelect = True MultiSelect = True
OnSelectionChange = VarListSelectionChange
TabOrder = 0 TabOrder = 0
end end
object InBtn: TBitBtn object InBtn: TBitBtn
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = Owner
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = VarList AnchorSideTop.Control = VarList
Left = 202 Left = 198
Height = 28 Height = 28
Top = 26 Top = 26
Width = 28 Width = 28
@ -147,7 +148,7 @@ object CoxRegFrm: TCoxRegFrm
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = InBtn AnchorSideTop.Control = InBtn
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 202 Left = 198
Height = 28 Height = 28
Top = 58 Top = 58
Width = 28 Width = 28
@ -162,7 +163,7 @@ object CoxRegFrm: TCoxRegFrm
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = Owner
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = Label3 AnchorSideTop.Control = Label3
Left = 202 Left = 198
Height = 28 Height = 28
Top = 108 Top = 108
Width = 28 Width = 28
@ -177,7 +178,7 @@ object CoxRegFrm: TCoxRegFrm
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = DepInBtn AnchorSideTop.Control = DepInBtn
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 202 Left = 198
Height = 28 Height = 28
Top = 140 Top = 140
Width = 28 Width = 28
@ -192,7 +193,7 @@ object CoxRegFrm: TCoxRegFrm
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = Owner
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideBottom.Control = StatusOutBtn AnchorSideBottom.Control = StatusOutBtn
Left = 202 Left = 198
Height = 28 Height = 28
Top = 187 Top = 187
Width = 28 Width = 28
@ -210,7 +211,7 @@ object CoxRegFrm: TCoxRegFrm
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideBottom.Control = VarList AnchorSideBottom.Control = VarList
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 202 Left = 198
Height = 28 Height = 28
Top = 219 Top = 219
Width = 28 Width = 28
@ -229,16 +230,17 @@ object CoxRegFrm: TCoxRegFrm
AnchorSideRight.Control = Owner AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Label3 AnchorSideBottom.Control = Label3
Left = 238 Left = 234
Height = 67 Height = 67
Top = 25 Top = 25
Width = 186 Width = 182
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Top = 2 BorderSpacing.Top = 2
BorderSpacing.Right = 8 BorderSpacing.Right = 8
BorderSpacing.Bottom = 16 BorderSpacing.Bottom = 16
ItemHeight = 0 ItemHeight = 0
OnSelectionChange = VarListSelectionChange
TabOrder = 3 TabOrder = 3
end end
object DepVar: TEdit object DepVar: TEdit
@ -248,13 +250,14 @@ object CoxRegFrm: TCoxRegFrm
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = Owner AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 238 Left = 234
Height = 23 Height = 23
Top = 125 Top = 125
Width = 186 Width = 182
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Right = 8 BorderSpacing.Right = 8
ReadOnly = True
TabOrder = 6 TabOrder = 6
Text = 'DepVar' Text = 'DepVar'
end end
@ -265,14 +268,15 @@ object CoxRegFrm: TCoxRegFrm
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = StatusOutBtn AnchorSideBottom.Control = StatusOutBtn
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 238 Left = 234
Height = 23 Height = 23
Top = 212 Top = 212
Width = 186 Width = 182
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Right = 8 BorderSpacing.Right = 8
BorderSpacing.Bottom = 12 BorderSpacing.Bottom = 12
ReadOnly = True
TabOrder = 9 TabOrder = 9
Text = 'StatusEdit' Text = 'StatusEdit'
end end
@ -323,97 +327,80 @@ object CoxRegFrm: TCoxRegFrm
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Label5 AnchorSideTop.Control = Label5
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 320 Left = 344
Height = 23 Height = 23
Top = 292 Top = 292
Width = 42 Width = 42
Alignment = taRightJustify Alignment = taRightJustify
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Right = 8
TabOrder = 11 TabOrder = 11
Text = 'MaxItsEdit' Text = 'MaxItsEdit'
end end
object ResetBtn: TButton object ResetBtn: TButton
AnchorSideRight.Control = CancelBtn AnchorSideRight.Control = ComputeBtn
AnchorSideBottom.Control = Owner AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 111 Left = 215
Height = 25 Height = 25
Top = 368 Top = 368
Width = 54 Width = 54
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
AutoSize = True AutoSize = True
BorderSpacing.Left = 32 BorderSpacing.Left = 8
BorderSpacing.Top = 8 BorderSpacing.Top = 8
BorderSpacing.Right = 12 BorderSpacing.Right = 8
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
Caption = 'Reset' Caption = 'Reset'
OnClick = ResetBtnClick OnClick = ResetBtnClick
TabOrder = 12 TabOrder = 12
end end
object CancelBtn: TButton
AnchorSideRight.Control = ComputeBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 177
Height = 25
Top = 368
Width = 62
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 12
BorderSpacing.Top = 8
BorderSpacing.Right = 12
BorderSpacing.Bottom = 8
Caption = 'Cancel'
ModalResult = 2
TabOrder = 13
end
object ComputeBtn: TButton object ComputeBtn: TButton
AnchorSideRight.Control = ReturnBtn AnchorSideRight.Control = CloseBtn
AnchorSideBottom.Control = Owner AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 251 Left = 277
Height = 25 Height = 25
Top = 368 Top = 368
Width = 76 Width = 76
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
AutoSize = True AutoSize = True
BorderSpacing.Left = 12 BorderSpacing.Left = 8
BorderSpacing.Top = 8 BorderSpacing.Top = 8
BorderSpacing.Right = 12 BorderSpacing.Right = 8
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
Caption = 'Compute' Caption = 'Compute'
OnClick = ComputeBtnClick OnClick = ComputeBtnClick
TabOrder = 14 TabOrder = 13
end end
object ReturnBtn: TButton object CloseBtn: TButton
AnchorSideRight.Control = Owner AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 339 Left = 361
Height = 25 Height = 25
Top = 368 Top = 368
Width = 61 Width = 55
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
AutoSize = True AutoSize = True
BorderSpacing.Left = 12 BorderSpacing.Left = 8
BorderSpacing.Top = 8 BorderSpacing.Top = 8
BorderSpacing.Right = 32 BorderSpacing.Right = 8
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
Caption = 'Return' Caption = 'Close'
ModalResult = 1 ModalResult = 11
TabOrder = 15 TabOrder = 14
end end
object Bevel1: TBevel object Bevel1: TBevel
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = Owner
AnchorSideRight.Control = Owner AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = ReturnBtn AnchorSideBottom.Control = CloseBtn
Left = 0 Left = 0
Height = 8 Height = 8
Top = 352 Top = 352
Width = 432 Width = 424
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
Shape = bsBottomLine Shape = bsBottomLine
end end

876
applications/lazstats/source/forms/analysis/multiple_regression/coxregunit.pas
View File

@ -23,9 +23,8 @@ type
StatusInBtn: TBitBtn; StatusInBtn: TBitBtn;
StatusOutBtn: TBitBtn; StatusOutBtn: TBitBtn;
ResetBtn: TButton; ResetBtn: TButton;
CancelBtn: TButton;
ComputeBtn: TButton; ComputeBtn: TButton;
ReturnBtn: TButton; CloseBtn: TButton;
DescChk: TCheckBox; DescChk: TCheckBox;
MaxItsEdit: TEdit; MaxItsEdit: TEdit;
Label5: TLabel; Label5: TLabel;
@ -54,10 +53,12 @@ type
function ChiSq(x : double; n : integer) : double; function ChiSq(x : double; n : integer) : double;
function Norm(z : double): double; function Norm(z : double): double;
function ix(j, k, nCols : integer): integer; function ix(j, k, nCols : integer): integer;
procedure VarListSelectionChange(Sender: TObject; User: boolean);
private private
{ private declarations } { private declarations }
FAutoSized: Boolean; FAutoSized: Boolean;
procedure UpdateBtnStates;
public public
{ public declarations } { public declarations }
end; end;
@ -73,42 +74,41 @@ uses
{ TCoxRegFrm } { TCoxRegFrm }
procedure TCoxRegFrm.ResetBtnClick(Sender: TObject); procedure TCoxRegFrm.ResetBtnClick(Sender: TObject);
VAR i : integer; var
i: integer;
begin begin
BlockList.Clear; BlockList.Clear;
VarList.Clear; VarList.Clear;
for i := 1 to NoVariables do for i := 1 to NoVariables do
begin VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); ProbsChk.Checked := true;
end; DescChk.Checked := true;
InBtn.Enabled := true; DepVar.Text := '';
OutBtn.Enabled := false; StatusEdit.Text := '';
DepInBtn.Enabled := true; MaxItsEdit.Text := '20';
DepOutBtn.Enabled := false;
ProbsChk.Checked := true;
DescChk.Checked := true;
DepVar.Text := '';
StatusEdit.Text := '';
StatusInBtn.Enabled := true;
StatusOutBtn.Enabled := false;
MaxItsEdit.Text := '20';
end; end;
procedure TCoxRegFrm.StatusInBtnClick(Sender: TObject); procedure TCoxRegFrm.StatusInBtnClick(Sender: TObject);
VAR index : integer; var
index: integer;
begin begin
index := VarList.ItemIndex; index := VarList.ItemIndex;
StatusEdit.Text := VarList.Items.Strings[index]; if (index > -1) and (StatusEdit.Text = '') then
VarList.Items.Delete(index); begin
StatusOutBtn.Enabled := true; StatusEdit.Text := VarList.Items[index];
StatusInBtn.Enabled := false; VarList.Items.Delete(index);
end;
UpdateBtnStates;
end; end;
procedure TCoxRegFrm.StatusOutBtnClick(Sender: TObject); procedure TCoxRegFrm.StatusOutBtnClick(Sender: TObject);
begin begin
VarList.Items.Add(StatusEdit.Text); if (StatusEdit.Text <> '') then
StatusEdit.Text := ''; begin
StatusInBtn.Enabled := true; VarList.Items.Add(StatusEdit.Text);
StatusEdit.Text := '';
end;
UpdateBtnStates;
end; end;
procedure TCoxRegFrm.FormActivate(Sender: TObject); procedure TCoxRegFrm.FormActivate(Sender: TObject);
@ -118,11 +118,10 @@ begin
if FAutoSized then if FAutoSized then
exit; exit;
w := MaxValue([ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]);
ResetBtn.Constraints.MinWidth := w; ResetBtn.Constraints.MinWidth := w;
CancelBtn.Constraints.MinWidth := w;
ComputeBtn.Constraints.MinWidth := w; ComputeBtn.Constraints.MinWidth := w;
ReturnBtn.Constraints.MinWidth := w; CloseBtn.Constraints.MinWidth := w;
Constraints.MinWidth := Width; Constraints.MinWidth := Width;
Constraints.MinHeight := Height; Constraints.MinHeight := Height;
@ -133,7 +132,6 @@ end;
procedure TCoxRegFrm.FormCreate(Sender: TObject); procedure TCoxRegFrm.FormCreate(Sender: TObject);
begin begin
Assert(OS3MainFrm <> nil); Assert(OS3MainFrm <> nil);
if OutputFrm = nil then Application.CreateForm(TOutputFrm, OutputFrm);
end; end;
procedure TCoxRegFrm.FormShow(Sender: TObject); procedure TCoxRegFrm.FormShow(Sender: TObject);
@ -142,17 +140,29 @@ begin
end; end;
procedure TCoxRegFrm.DepInBtnClick(Sender: TObject); procedure TCoxRegFrm.DepInBtnClick(Sender: TObject);
VAR index : integer; var
index: integer;
begin begin
index := VarList.ItemIndex; index := VarList.ItemIndex;
DepVar.Text := VarList.Items.Strings[index]; if (index > -1) and (DepVar.Text = '') then
VarList.Items.Delete(index); begin
DepOutBtn.Enabled := true; DepVar.Text := VarList.Items[index];
DepInBtn.Enabled := false; VarList.Items.Delete(index);
end;
UpdateBtnStates;
end;
procedure TCoxRegFrm.DepOutBtnClick(Sender: TObject);
begin
if DepVar.Text <> '' then
begin
VarList.Items.Add(DepVar.Text);
DepVar.Text := '';
end;
UpdateBtnStates;
end; end;
procedure TCoxRegFrm.ComputeBtnClick(Sender: TObject); procedure TCoxRegFrm.ComputeBtnClick(Sender: TObject);
Label CleanUp;
var var
i, j, k : integer; i, j, k : integer;
indx : integer; indx : integer;
@ -192,409 +202,461 @@ var
Hi95 : double; Hi95 : double;
d : double; d : double;
iters : integer; iters : integer;
lReport: TStrings;
begin begin
OutputFrm.RichEdit.Clear; if MaxItsEdit.Text = '' then
// OutputFrm.RichEdit.ParaGraph.Alignment := taLeftJustify; begin
OutputFrm.RichEdit.Lines.Add('Cox Proportional Hazards Survival Regression Adapted from John C. Pezzullo'); MaxItsEdit.Setfocus;
OutputFrm.RichEdit.Lines.Add('Java program at http://members.aol.com/johnp71/prophaz.html'); MessageDlg('Maximum iterations not specified.', mtError, [mbOK], 0);
exit;
end;
{ get independent item columns } if not TryStrToInt(MaxItsEdit.Text, iters) then
nR := BlockList.Items.Count; begin
nC := NoCases; MaxItsEdit.SetFocus;
SetLength(ColNoSelected,nR + 2); MessageDlg('Valid number required.', mtError, [mbOK], 0);
SetLength(RowLabels,nR + 2); exit;
SetLength(ColLabels,nR + 2); end;
if nR < 1 then
begin
ShowMessage('ERROR! No independent variables selected.');
goto CleanUp;
end;
for i := 1 to nR do { get independent item columns }
begin nR := BlockList.Items.Count;
cellstring := BlockList.Items.Strings[i-1]; nC := NoCases;
for j := 1 to NoVariables do SetLength(ColNoSelected,nR + 2);
begin SetLength(RowLabels,nR + 2);
if cellstring = OS3MainFrm.DataGrid.Cells[j,0] then SetLength(ColLabels,nR + 2);
begin if nR < 1 then
ColNoSelected[i-1] := j; begin
RowLabels[i-1] := cellstring; MessageDlg('No independent variables selected.', mtError, [mbOK], 0);
ColLabels[i-1] := cellstring; exit;
end; end;
end;
end;
{ get survival time variable column and survival status var. column } for i := 1 to nR do
if DepVar.Text = '' then begin
begin cellstring := BlockList.Items.Strings[i-1];
ShowMessage('Error! No Survival time variable selected.');
goto CleanUp;
end;
if StatusEdit.Text = '' then
begin
ShowMessage('Error! No Survival Status variable selected.');
goto Cleanup;
end;
nP := nR + 1;
nS := nP + 1;
for j := 1 to NoVariables do for j := 1 to NoVariables do
begin begin
if DepVar.Text = OS3MainFrm.DataGrid.Cells[j,0] then if cellstring = OS3MainFrm.DataGrid.Cells[j,0] then
begin begin
ColNoSelected[nP-1] := j; ColNoSelected[i-1] := j;
RowLabels[nP-1] := OS3MainFrm.DataGrid.Cells[j,0]; RowLabels[i-1] := cellstring;
ColLabels[nP-1] := RowLabels[nP-1]; ColLabels[i-1] := cellstring;
end; end;
if StatusEdit.Text = OS3MainFrm.DataGrid.Cells[j,0] then
begin
ColNoSelected[nS-1] := j;
RowLabels[nS-1] := OS3MainFrm.DataGrid.Cells[j,0];
ColLabels[nS-1] := RowLabels[nS-1];
end;
end; end;
end;
SetLength(SurvT,nC + 1); { get survival time variable column and survival status var. column }
SetLength(Stat,nC + 1); if DepVar.Text = '' then
SetLength(Dupl,nC + 1); begin
SetLength(Alpha,nC + 1); MessageDlg('No Survival time variable selected.', mtError, [mbOK], 0);
SetLength(x,(nC + 1) * (nR + 1)); exit;
SetLength(b,nC + 1); end;
SetLength(a,(nR + 1) * (nR + 1)); if StatusEdit.Text = '' then
SetLength(s1,nR + 1); begin
SetLength(s2,(nR + 1) * (nR + 1)); MessageDlg('No Survival Status variable selected.', mtError, [mbOK], 0);
SetLength(s,nR + 1); exit;
SetLength(Av,nR + 1); end;
SetLength(SD,nR + 1); nP := nR + 1;
SetLength(SE,nR + 1); nS := nP + 1;
for j := 1 to NoVariables do
begin
if DepVar.Text = OS3MainFrm.DataGrid.Cells[j,0] then
begin
ColNoSelected[nP-1] := j;
RowLabels[nP-1] := OS3MainFrm.DataGrid.Cells[j,0];
ColLabels[nP-1] := RowLabels[nP-1];
end;
if StatusEdit.Text = OS3MainFrm.DataGrid.Cells[j,0] then
begin
ColNoSelected[nS-1] := j;
RowLabels[nS-1] := OS3MainFrm.DataGrid.Cells[j,0];
ColLabels[nS-1] := RowLabels[nS-1];
end;
end;
// get data SetLength(SurvT,nC + 1);
for i := 0 to nC - 1 do SetLength(Stat,nC + 1);
begin SetLength(Dupl,nC + 1);
indx := ix(i,0,nR+1); SetLength(Alpha,nC + 1);
X[indx] := 1; SetLength(x,(nC + 1) * (nR + 1));
for j := 0 to nR-1 do SetLength(b,nC + 1);
begin SetLength(a,(nR + 1) * (nR + 1));
indx := ColNoSelected[j]; SetLength(s1,nR + 1);
zX := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[indx,i+1])); SetLength(s2,(nR + 1) * (nR + 1));
indx := ix(i,j,nR); SetLength(s,nR + 1);
x[indx] := zX; SetLength(Av,nR + 1);
Av[j] := Av[j] + zX; SetLength(SD,nR + 1);
SD[j] := SD[j] + (zX * zX); SetLength(SE,nR + 1);
end;
// get survival time
indx := ColNoSelected[nP-1];
zX := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[indx,i+1]));
SurvT[i] := zX;
// get survival status
indx := ColNoSelected[nS-1];
zX := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[indx,i+1]));
Stat[i] := zX;
end; // next case i
// print descriptive statistics // get data
OutputFrm.RichEdit.Lines.Add(''); for i := 0 to nC - 1 do
if DescChk.Checked then begin
begin indx := ix(i,0,nR+1);
OutputFrm.RichEdit.Lines.Add('Descriptive Statistics'); X[indx] := 1;
OutputFrm.RichEdit.Lines.Add('Variable Label Average Std.Dev.'); for j := 0 to nR-1 do
end; begin
for j := 0 to nR-1 do indx := ColNoSelected[j];
begin zX := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[indx,i+1]));
Av[j] := Av[j] / nC; indx := ix(i,j,nR);
SD[j] := SD[j] / nC; x[indx] := zX;
SD[j] := sqrt( abs(SD[j] - Av[j] * Av[j])); Av[j] := Av[j] + zX;
if DescChk.Checked then SD[j] := SD[j] + (zX * zX);
begin end;
outline := format(' %3d %15s %10.4f %10.4f',[j+1,RowLabels[j],Av[j],SD[j]]); // get survival time
OutputFrm.RichEdit.Lines.Add(outline); indx := ColNoSelected[nP-1];
end; zX := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[indx,i+1]));
end; SurvT[i] := zX;
OutputFrm.RichEdit.Lines.Add(''); // get survival status
indx := ColNoSelected[nS-1];
zX := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[indx,i+1]));
Stat[i] := zX;
end; // next case i
d := 0.0; // print descriptive statistics
Eps := 1.0 / 1024.0; lReport := TStringList.Create;
for i := 0 to nC-2 do try
begin lReport.Add('COX PROPORTIONAL HARARDS SURVIVAL REGRESSION adapted from John C. Pezzullo');
iBig := i; lReport.Add('Java program at http://members.aol.com/johnp71/prophaz.html');
for j := i+1 to nC-1 do lReport.Add('');
begin
if (SurvT[j] - Eps * Stat[j]) > (SurvT[iBig]-Eps * Stat[iBig]) then
iBig := j;
end;
if iBig <> i then
begin
v := SurvT[i];
SurvT[i] := SurvT[iBig];
SurvT[iBig] := v;
v := Stat[i];
Stat[i] := Stat[iBig];
Stat[iBig] := v;
for j := 0 to nR-1 do
begin
v := x[ix(i,j,nR)];
x[ix(i,j,nR)] := x[ix(iBig,j,nR)];
x[ix(iBig,j,nR)] := v;
end;
end;
end;
if Stat[0] > 0 then Stat[0] := Stat[0] + 2; if DescChk.Checked then
for i := 1 to nC-1 do begin
begin lReport.Add('Descriptive Statistics');
if (Stat[i] > 0) and ((Stat[i-1] = 0) or (SurvT[i-1] <> SurvT[i])) then lReport.Add('Variable Label Average Std.Dev.');
Stat[i] := Stat[i] + 2; end;
end; for j := 0 to nR-1 do
if Stat[nC-1] > 0 then Stat[nC-1] := Stat[nC-1] + 4; begin
for i := nC-2 downto 0 do Av[j] := Av[j] / nC;
begin SD[j] := SD[j] / nC;
if (Stat[i] > 0) and ((Stat[i+1] = 0) or (SurvT[i+1] <> Survt[i])) then SD[j] := sqrt( abs(SD[j] - Av[j] * Av[j]));
Stat[i] := Stat[i] + 4; if DescChk.Checked then
end; lReport.Add(' %3d %15s %11.4f %11.4f', [j+1, RowLabels[j], Av[j], SD[j]]);
for i := 0 to nC-1 do end;
begin lReport.Add('');
for j := 0 to nR-1 do
begin
x[ix(i,j,nR)] := (x[ix(i,j,nR)] - Av[j]) / SD[j];
end;
end;
if ItersChk.Checked then OutputFrm.RichEdit.Lines.Add('Iteration History...');
for j := 0 to nR-1 do b[j] := 0;
LLp := 2.0e30;
LL := 1.0e30;
// start iterations d := 0.0;
iters := 0; Eps := 1.0 / 1024.0;
while (Abs(LLp-LL) > 0.0001) do for i := 0 to nC-2 do
begin begin
iters := iters + 1; iBig := i;
if iters > StrToInt(MaxItsEdit.Text) then break; for j := i+1 to nC-1 do
LLp := LL; if (SurvT[j] - Eps * Stat[j]) > (SurvT[iBig]-Eps * Stat[iBig]) then
LL := 0.0; iBig := j;
s0 := 0.0; if iBig <> i then
for j := 0 to nR-1 do begin
begin v := SurvT[i];
s1[j] := 0.0; SurvT[i] := SurvT[iBig];
a[ix(j,nR,nR+1)] := 0.0; SurvT[iBig] := v;
for k := 0 to nR-1 do v := Stat[i];
begin Stat[i] := Stat[iBig];
s2[ix(j,k,nR)] := 0.0; Stat[iBig] := v;
a[ix(j,k,nR+1)] := 0.0; for j := 0 to nR-1 do
end; begin
end; v := x[ix(i,j,nR)];
for i := 0 to nC-1 do x[ix(i,j,nR)] := x[ix(iBig,j,nR)];
begin x[ix(iBig,j,nR)] := v;
Alpha[i] := 1.0; end;
v := 0.0; end;
for j := 0 to nR-1 do v := v + b[j] * x[ix(i,j,nR)]; end;
v := exp(v);
s0 := s0 + v;
for j := 0 to nR-1 do
begin
s1[j] := s1[j] + x[ix(i,j,nR)] * v;
for k := 0 to nR-1 do
s2[ix(j,k,nR)] := s2[ix(j,k,nR)] + x[ix(i,j,nR)] * x[ix(i,k,nR)] * v;
end;
StatI := Stat[i];
if (StatI = 2) or (StatI = 3) or (StatI = 6) or (StatI = 7) then
begin
d := 0.0;
for j := 0 to nR-1 do s[j] := 0.0;
end;
if (StatI = 1) or (StatI = 3) or (StatI = 5) or (StatI = 7) then
begin
d := d + 1;
for j := 0 to nR-1 do s[j] := s[j] + x[ix(i,j,nR)];
end;
if (StatI = 4) or (StatI = 5) or (StatI = 6) or (StatI = 7) then
begin
for j := 0 to nR-1 do
begin
LL := LL + s[j] * b[j];
a[ix(j,nR,nR+1)] := a[ix(j,nR,nR+1)] + s[j] - d * s1[j] / s0;
for k := 0 to nR-1 do
begin
a[ix(j,k,nR+1)] := a[ix(j,k,nR+1)] + d * (s2[ix(j,k,nR)] / s0 -
s1[j] * s1[k] / (s0 * s0));
end;
end;
LL := LL - d * Ln(s0);
if d = 1 then Alpha[i] := Power((1.0 - v / s0),(1.0 / v))
else Alpha[i] := exp(-d / s0);
end;
end;
LL := -2.0 * LL;
outline := format('-2 Log Likelihood = %10.4f',[LL]);
if iters = 1 then
begin
LLn := LL;
if ItersChk.Checked then
outline := outline + ' (Null Model)';
end;
if ItersChk.Checked then
OutputFrm.RichEdit.Lines.Add(outline);
for i := 0 to nR-1 do
begin
v := a[ix(i,i,nR+1)];
a[ix(i,i,nR+1)] := 1.0;
for k := 0 to nR do
a[ix(i,k,nR+1)] := a[ix(i,k,nR+1)] / v;
for j := 0 to nR-1 do
begin
if i <> j then
begin
v := a[ix(j,i,nR+1)];
a[ix(j,i,nR+1)] := 0.0;
for k := 0 to nR do
a[ix(j,k,nR+1)] := a[ix(j,k,nR+1)] - v * a[ix(i,k,nR+1)];
end;
end;
end;
for j := 0 to nR-1 do b[j] := b[j] + a[ix(j,nR,nR+1)];
end;
OutputFrm.RichEdit.Lines.Add('Converged'); if Stat[0] > 0 then
Csq := LLn - LL; Stat[0] := Stat[0] + 2;
OutputFrm.RichEdit.Lines.Add('');
OutputFrm.RichEdit.Lines.Add('Overall Model Fit...');
if Csq > 0.0 then prob := ChiSq(Csq,nR) else prob := 1.0;
outline := format('Chi Square = %8.4f with d.f. %d and probability = %8.4f',[Csq,nR,prob]);
OutputFrm.RichEdit.Lines.Add(outline);
OutputFrm.RichEdit.Lines.Add('');
OutputFrm.RichEdit.Lines.Add('Coefficients, Std Errs, Signif, and Confidence Intervals');
OutputFrm.RichEdit.Lines.Add('');
OutputFrm.RichEdit.Lines.Add('Var Coeff. StdErr p Lo95% Hi95%');
for j := 0 to nR-1 do
begin
b[j] := b[j] / SD[j];
SE[j] := sqrt(a[ix(j,j,nR+1)]) / SD[j];
prob := Norm(Abs(b[j] / SE[j]));
Lo95 := b[j] - 1.96 * SE[j];
Hi95 := b[j] + 1.96 * SE[j];
outline := format('%10s %10.4f %10.4f %8.4f %8.4f %8.4f',
[RowLabels[j],b[j],SE[j],prob,Lo95,Hi95]);
OutputFrm.RichEdit.Lines.Add(outline);
end;
OutputFrm.RichEdit.Lines.Add('');
OutputFrm.RichEdit.Lines.Add('Risk Ratios and Confidence Intervals');
OutputFrm.RichEdit.Lines.Add('');
OutputFrm.RichEdit.Lines.Add('Variable Risk Ratio Lo95% Hi95%');
for j := 0 to nR-1 do
begin
outline := format('%10s %10.4f %10.4f %10.4f',
[RowLabels[j],exp(b[j]),exp(b[j]-1.96*SE[j]),exp(b[j]+1.96*SE[j])]);
OutputFrm.RichEdit.Lines.Add(outline);
end;
OutputFrm.RichEdit.Lines.Add('');
if ProbsChk.Checked then
OutputFrm.RichEdit.Lines.Add('Baseline Survivor Function (at predictor means)...');
SF := 1.0;
for i := nC-1 downto 0 do
begin
Sf := Sf * Alpha[i];
if Alpha[i] < 1.0 then
begin
if ProbsChk.Checked then
begin
outline := format('%10.4f %10.4f',[SurvT[i],Sf]);
OutputFrm.RichEdit.Lines.Add(outline);
end;
end;
end;
OutputFrm.ShowModal;
cleanup: for i := 1 to nC-1 do
SurvT := nil; begin
Stat := nil; if (Stat[i] > 0) and ((Stat[i-1] = 0) or (SurvT[i-1] <> SurvT[i])) then
Dupl := nil; Stat[i] := Stat[i] + 2;
Alpha := nil; end;
x := nil; if Stat[nC-1] > 0 then
b := nil; Stat[nC-1] := Stat[nC-1] + 4;
a := nil;
s1 := nil;
s2 := nil;
s := nil;
Av := nil;
SD := nil;
SE := nil;
RowLabels := nil;
ColLabels := nil;
ColNoSelected := nil;
end;
procedure TCoxRegFrm.DepOutBtnClick(Sender: TObject); for i := nC-2 downto 0 do
begin begin
VarList.Items.Add(DepVar.Text); if (Stat[i] > 0) and ((Stat[i+1] = 0) or (SurvT[i+1] <> Survt[i])) then
DepVar.Text := ''; Stat[i] := Stat[i] + 4;
DepInBtn.Enabled := true; end;
for i := 0 to nC-1 do
begin
for j := 0 to nR-1 do
begin
x[ix(i,j,nR)] := (x[ix(i,j,nR)] - Av[j]) / SD[j];
end;
end;
if ItersChk.Checked then
lReport.Add('Iteration History...');
for j := 0 to nR-1 do b[j] := 0;
LLp := 2.0e30;
LL := 1.0e30;
// start iterations
iters := 0;
while (Abs(LLp-LL) > 0.0001) do
begin
iters := iters + 1;
if iters > StrToInt(MaxItsEdit.Text) then break;
LLp := LL;
LL := 0.0;
s0 := 0.0;
for j := 0 to nR-1 do
begin
s1[j] := 0.0;
a[ix(j,nR,nR+1)] := 0.0;
for k := 0 to nR-1 do
begin
s2[ix(j,k,nR)] := 0.0;
a[ix(j,k,nR+1)] := 0.0;
end;
end;
for i := 0 to nC-1 do
begin
Alpha[i] := 1.0;
v := 0.0;
for j := 0 to nR-1 do v := v + b[j] * x[ix(i,j,nR)];
v := exp(v);
s0 := s0 + v;
for j := 0 to nR-1 do
begin
s1[j] := s1[j] + x[ix(i,j,nR)] * v;
for k := 0 to nR-1 do
s2[ix(j,k,nR)] := s2[ix(j,k,nR)] + x[ix(i,j,nR)] * x[ix(i,k,nR)] * v;
end;
StatI := Stat[i];
if (StatI = 2) or (StatI = 3) or (StatI = 6) or (StatI = 7) then
begin
d := 0.0;
for j := 0 to nR-1 do s[j] := 0.0;
end;
if (StatI = 1) or (StatI = 3) or (StatI = 5) or (StatI = 7) then
begin
d := d + 1;
for j := 0 to nR-1 do s[j] := s[j] + x[ix(i,j,nR)];
end;
if (StatI = 4) or (StatI = 5) or (StatI = 6) or (StatI = 7) then
begin
for j := 0 to nR-1 do
begin
LL := LL + s[j] * b[j];
a[ix(j,nR,nR+1)] := a[ix(j,nR,nR+1)] + s[j] - d * s1[j] / s0;
for k := 0 to nR-1 do
begin
a[ix(j,k,nR+1)] := a[ix(j,k,nR+1)] + d * (s2[ix(j,k,nR)] / s0 -
s1[j] * s1[k] / (s0 * s0));
end;
end;
LL := LL - d * Ln(s0);
if d = 1 then Alpha[i] := Power((1.0 - v / s0),(1.0 / v))
else Alpha[i] := exp(-d / s0);
end;
end;
LL := -2.0 * LL;
outline := format('-2 Log Likelihood: %.4f',[LL]);
if iters = 1 then
begin
LLn := LL;
if ItersChk.Checked then
outline := outline + ' (Null Model)';
end;
if ItersChk.Checked then
lReport.Add(outline);
for i := 0 to nR-1 do
begin
v := a[ix(i,i,nR+1)];
a[ix(i,i,nR+1)] := 1.0;
for k := 0 to nR do
a[ix(i,k,nR+1)] := a[ix(i,k,nR+1)] / v;
for j := 0 to nR-1 do
begin
if i <> j then
begin
v := a[ix(j,i,nR+1)];
a[ix(j,i,nR+1)] := 0.0;
for k := 0 to nR do
a[ix(j,k,nR+1)] := a[ix(j,k,nR+1)] - v * a[ix(i,k,nR+1)];
end;
end;
end;
for j := 0 to nR-1 do b[j] := b[j] + a[ix(j,nR,nR+1)];
end;
lReport.Add('Converged');
Csq := LLn - LL;
lReport.Add('');
lReport.Add('Overall Model Fit...');
if Csq > 0.0 then prob := ChiSq(Csq,nR) else prob := 1.0;
lReport.Add('Chi Square: %8.4f', [csq]);
lReport.Add(' with d.f. %8d', [nR]);
lReport.Add(' and probability: %8.4f', [prob]);
lReport.Add('');
lReport.Add('Coefficients, Std Errs, Signif, and Confidence Intervals');
lReport.Add('');
lReport.Add('Var Coeff. StdErr p Lo95% Hi95%');
for j := 0 to nR-1 do
begin
b[j] := b[j] / SD[j];
SE[j] := sqrt(a[ix(j,j,nR+1)]) / SD[j];
prob := Norm(Abs(b[j] / SE[j]));
Lo95 := b[j] - 1.96 * SE[j];
Hi95 := b[j] + 1.96 * SE[j];
lReport.Add('%10s %10.4f %10.4f %8.4f %8.4f %8.4f',
[RowLabels[j], b[j], SE[j], prob, Lo95, Hi95]);
end;
lReport.Add('');
lReport.Add('Risk Ratios and Confidence Intervals');
lReport.Add('');
lReport.Add('Variable Risk Ratio Lo95% Hi95%');
for j := 0 to nR-1 do
lReport.Add('%10s %10.4f %10.4f %10.4f',
[RowLabels[j], exp(b[j]), exp(b[j]-1.96*SE[j]), exp(b[j]+1.96*SE[j])]);
lReport.Add('');
if ProbsChk.Checked then
lReport.Add('Baseline Survivor Function (at predictor means)...');
SF := 1.0;
for i := nC-1 downto 0 do
begin
Sf := Sf * Alpha[i];
if Alpha[i] < 1.0 then
begin
if ProbsChk.Checked then
lReport.Add('%10.4f %10.4f', [SurvT[i], Sf]);
end;
end;
DisplayReport(lReport);
finally
lReport.Free;
SurvT := nil;
Stat := nil;
Dupl := nil;
Alpha := nil;
x := nil;
b := nil;
a := nil;
s1 := nil;
s2 := nil;
s := nil;
Av := nil;
SD := nil;
SE := nil;
RowLabels := nil;
ColLabels := nil;
ColNoSelected := nil;
end;
end; end;
procedure TCoxRegFrm.InBtnClick(Sender: TObject); procedure TCoxRegFrm.InBtnClick(Sender: TObject);
VAR i, index : integer; var
i: integer;
begin begin
index := VarList.Items.Count; i := 0;
i := 0; while i < VarList.Items.Count do
while i < index do begin
begin if VarList.Selected[i] then
if (VarList.Selected[i]) then begin
begin BlockList.Items.Add(VarList.Items[i]);
BlockList.Items.Add(VarList.Items.Strings[i]); VarList.Items.Delete(i);
VarList.Items.Delete(i); i := 0;
index := index - 1; end else
i := 0; i := i + 1;
end end;
else i := i + 1; UpdateBtnStates;
end;
OutBtn.Enabled := true;
end; end;
procedure TCoxRegFrm.OutBtnClick(Sender: TObject); procedure TCoxRegFrm.OutBtnClick(Sender: TObject);
VAR index : integer;
begin
index := BlockList.ItemIndex;
VarList.Items.Add(BlockList.Items.Strings[index]);
BlockList.Items.Delete(index);
InBtn.Enabled := true;
if BlockList.Items.Count = 0 then OutBtn.Enabled := false;
end;
function TCoxRegFrm.ChiSq(x : double; n : integer) : double;
var var
p, t, a : double; i: integer;
k : integer;
begin begin
p := exp(-0.5 * x); i := 0;
if n mod 2 = 1 then p := p * sqrt(2 * x / Pi); while i < BlockList.Items.Count do
k := n; begin
while K >= 2 do if BlockList.Selected[i] then
begin begin
p := p * x / k; VarList.Items.Add(BlockList.Items[i]);
k := k - 2; BlockList.Items.Delete(i);
end; i := 0;
t := p; end else
a := n; i := i + 1;
while t > 0.000001 * p do end;
begin UpdateBtnStates;
a := a + 2;
t := t * x / a;
p := p + t;
end;
ChiSq := (1 - p);
end; end;
//-------------------------------------------------------------------
function TCoxRegFrm.Norm(z : double): double; function TCoxRegFrm.ChiSq(x: double; n: integer): double;
var
p, t, a: double;
k: integer;
begin begin
Norm := ChiSq(z * z, 1); p := exp(-0.5 * x);
if n mod 2 = 1 then
p := p * sqrt(2 * x / Pi);
k := n;
while K >= 2 do
begin
p := p * x / k;
k := k - 2;
end;
t := p;
a := n;
while t > 0.000001 * p do
begin
a := a + 2;
t := t * x / a;
p := p + t;
end;
Result := (1 - p);
end;
function TCoxRegFrm.Norm(z: double): double;
begin
Result := ChiSq(z*z, 1);
end; end;
//------------------------------------------------------------------- //-------------------------------------------------------------------
function TCoxRegFrm.ix(j, k, nCols : integer): integer; function TCoxRegFrm.ix(j, k, nCols : integer): integer;
begin begin
ix := j * nCols + k; Result := j*nCols + k;
end; end;
procedure TCoxRegFrm.UpdateBtnStates;
var
i: Integer;
lSelected: Boolean;
begin
lSelected := false;
for i := 0 to VarList.Items.Count-1 do
if VarList.Selected[i] then
begin
lSelected := true;
break;
end;
InBtn.Enabled := lSelected;
DepInBtn.Enabled := lSelected and (DepVar.Text = '');
StatusInBtn.Enabled := lSelected and (StatusEdit.Text = '');
lSelected := false;
for i := 0 to BlockList.Items.Count-1 do
if BlockList.Selected[i] then
begin
lSelected := true;
break;
end;
OutBtn.Enabled := lSelected;
DepOutBtn.Enabled := DepVar.Text <> '';
StatusOutBtn.Enabled := StatusEdit.Text <> '';
end;
procedure TCoxRegFrm.VarListSelectionChange(Sender: TObject; User: boolean);
begin
UpdateBtnStates;
end;
initialization initialization
{$I coxregunit.lrs} {$I coxregunit.lrs}