pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity
Files
c95d86dba082c99173b6dc50f714c99dba0938a4
lazarus-ccr/applications/lazstats/source_orig/kaplanmeierunit.pas
wp_xxyyzz 15870755f1 LazStats: Adding original source, part 5. 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7884 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2020-11-16 11:13:29 +00:00

1070 lines
38 KiB
ObjectPascal
Raw Blame History

unit KaplanMeierUnit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, Buttons, MainUnit, Globals, functionsLib, OutPutUnit, DataProcs,
DictionaryUnit, Math, Clipbrd, contexthelpunit;
type
{ TKaplanMeierFrm }
TKaplanMeierFrm = class(TForm)
HelpBtn: TButton;
ResetBtn: TButton;
CancelBtn: TButton;
ComputeBtn: TButton;
ReturnBtn: TButton;
PlotChk: TCheckBox;
PrintChk: TCheckBox;
GroupBox1: TGroupBox;
TimeInBtn: TBitBtn;
TimeOutBtn: TBitBtn;
EventInBtn: TBitBtn;
EventOutBtn: TBitBtn;
GroupInBtn: TBitBtn;
GroupOutBtn: TBitBtn;
TimeEdit: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
EventEdit: TEdit;
GroupEdit: TEdit;
VarList: TListBox;
procedure ComputeBtnClick(Sender: TObject);
procedure EventInBtnClick(Sender: TObject);
procedure EventOutBtnClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure GroupInBtnClick(Sender: TObject);
procedure GroupOutBtnClick(Sender: TObject);
procedure HelpBtnClick(Sender: TObject);
procedure ResetBtnClick(Sender: TObject);
procedure TimeInBtnClick(Sender: TObject);
procedure TimeOutBtnClick(Sender: TObject);
private
{ private declarations }
procedure plotxy(var Xpoints : IntDyneVec;
var Ypoints : DblDyneVec;
var Dropped : IntDyneVec;
var Dropped2 : IntDyneVec;
Xmax, Xmin, Ymax, Ymin : double;
N : integer;
XEdit : string;
YEdit : string;
curveno : integer);
public
{ public declarations }
end;
var
KaplanMeierFrm: TKaplanMeierFrm;
implementation
uses BlankFrmUnit;
{ TKaplanMeierFrm }
procedure TKaplanMeierFrm.ResetBtnClick(Sender: TObject);
VAR i : integer;
begin
VarList.Clear;
for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
TimeEdit.Text := '';
EventEdit.Text := '';
GroupEdit.Text := '';
PlotChk.Checked := false;
PrintChk.Checked := false;
TimeInBtn.Visible := true;
EventInBtn.Visible := true;
GroupInBtn.Visible := true;
TimeOutBtn.Visible := false;
EventOutBtn.Visible := false;
GroupOutBtn.Visible := false;
end;
procedure TKaplanMeierFrm.TimeInBtnClick(Sender: TObject);
VAR i : integer;
begin
i := VarList.ItemIndex;
TimeEdit.Text := VarList.Items.Strings[i];
VarList.Items.Delete(i);
TimeInBtn.Visible := false;
TimeOutBtn.Visible := true;
end;
procedure TKaplanMeierFrm.TimeOutBtnClick(Sender: TObject);
begin
VarList.Items.Add(TimeEdit.Text);
TimeEdit.Text := '';
TimeInBtn.Visible := true;
TimeOutBtn.Visible := false;
end;
procedure TKaplanMeierFrm.FormShow(Sender: TObject);
begin
ResetBtnClick(self);
end;
procedure TKaplanMeierFrm.GroupInBtnClick(Sender: TObject);
VAR i : integer;
begin
i := VarList.ItemIndex;
GroupEdit.Text := VarList.Items.Strings[i];
VarList.Items.Delete(i);
GroupInBtn.Visible := false;
GroupOutBtn.Visible := true;
end;
procedure TKaplanMeierFrm.GroupOutBtnClick(Sender: TObject);
begin
VarList.Items.Add(GroupEdit.Text);
GroupEdit.Text := '';
GroupInBtn.Visible := true;
GroupOutBtn.Visible := false;
end;
procedure TKaplanMeierFrm.HelpBtnClick(Sender: TObject);
begin
ContextHelpForm.HelpMessage((Sender as TButton).tag);
end;
procedure TKaplanMeierFrm.EventInBtnClick(Sender: TObject);
VAR i : integer;
begin
i := VarList.ItemIndex;
EventEdit.Text := VarList.Items.Strings[i];
VarList.Items.Delete(i);
EventInBtn.Visible := false;
EventOutBtn.Visible := true;
end;
procedure TKaplanMeierFrm.ComputeBtnClick(Sender: TObject);
var
outline, astring : string;
PrintIt, Graph1, TwoGroups : boolean;
Size1, Size2, TotalSize, NoDeaths, ThisTime, FoundIn, GraphType : integer;
mintime, maxtime, tempint, nopoints, noprobs, tempvalue : integer;
NoCensored, nocats, i, j, k, icase, oldtime, pos, first, last : integer;
noinexp, noincntrl, count, TimeCol, DeathsCol, CensoredCol : integer;
GroupCol : integer;
minprob, maxprob, cumprop, proportion, term1, term2, term3 : double;
E1, E2, O1, O2, Chisquare, ProbChi, Risk, LogRisk, SELogRisk : double;
HiConf, LowConf, HiLogLevel, LowLogLevel, lastexp, lastctr : double;
TimePlot, Dropped, Dropped2, Time, AtRisk, Dead, SurvivalTimes : IntDyneVec;
ExpCnt, CntrlCnt, TotalatRisk, ExpatRisk, CntrlatRisk : IntDyneVec;
Deaths, Group, Censored : IntDyneVec;
ProbPlot, ProbPlot2, CondProb, ExpProp, CntrlProp : DblDyneVec;
CumPropExp, CumPropCntrl : DblDyneVec;
TimeLabel, GroupLabel, DeathsLabel : string;
begin
PrintIt := false;
// get options
if (PlotChk.Checked = true) then Graph1 := true
else Graph1 := false;
if (PrintChk.Checked) then PrintIt := true else PrintIt := false;
// get variable columns and labels
TimeLabel := TimeEdit.Text;
GroupLabel := GroupEdit.Text;
DeathsLabel := EventEdit.Text;
TimeCol := 0;
DeathsCol := 0;
CensoredCol := 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
begin
ShowMessage('ERROR! One or more variables not selected.');
exit;
end;
if (GroupEdit.Text = '') then
begin
TwoGroups := false;
Size1 := NoCases;
Size2 := 0;
end
else
begin
Size1 := 0;
Size2 := 0;
TwoGroups := true;
for i := 1 to NoCases do
begin
if (StrToInt(OS3MainFrm.DataGrid.Cells[GroupCol,i]) = 1) then
Size1 := Size1 + 1
else Size2 := Size2 + 1;
end;
end;
// allocate space for the data
SetLength(SurvivalTimes,NoCases+2);
SetLength(ExpCnt,NoCases+2);
SetLength(CntrlCnt,NoCases+2);
SetLength(TotalatRisk,NoCases+2);
SetLength(ExpatRisk,NoCases+2);
SetLength(CntrlatRisk,NoCases+2);
SetLength(ExpProp,NoCases+2);
SetLength(CntrlProp,NoCases+2);
SetLength(Deaths,NoCases+2);
SetLength(Group,NoCases+2);
SetLength(Censored,NoCases+2);
SetLength(CumPropExp,NoCases+2);
SetLength(CumPropCntrl,NoCases+2);
// initialize arrays
for i := 0 to NoCases+1 do
begin
SurvivalTimes[i] := 0;
ExpCnt[i] := 0;
CntrlCnt[i] := 0;
TotalatRisk[i] := 0;
ExpatRisk[i] := 0;
CntrlatRisk[i] := 0;
ExpProp[i] := 0.0;
CntrlProp[i] := 0.0;
Deaths[i] := 0;
Group[i] := 0;
Censored[i] := 0;
CumPropExp[i] := 0.0;
CumPropCntrl[i] := 0.0;
end;
mintime := 0;
maxtime := 0;
// Get Data
if (not TwoGroups) then
begin
for i := 1 to NoCases do
begin
SurvivalTimes[i] := StrToInt(OS3MainFrm.DataGrid.Cells[TimeCol,i]);
if (SurvivalTimes[i] > maxtime) then maxtime := SurvivalTimes[i];
tempvalue := StrToInt(OS3MainFrm.DataGrid.Cells[DeathsCol,i]);
if (tempvalue = 1) then Deaths[i] := 1 else Deaths[i] := 0;
if (tempvalue = 2) then Censored[i] := 1 else Censored[i] := 0;
end;
// sort cases by time
for i := 0 to NoCases - 1 do
begin
for j := i + 1 to NoCases do
begin
if (SurvivalTimes[i] > SurvivalTimes[j]) then
begin
tempint := SurvivalTimes[i];
SurvivalTimes[i] := SurvivalTimes[j];
SurvivalTimes[j] := tempint;
tempint := Censored[i];
Censored[i] := Censored[j];
Censored[j] := tempint;
tempint := Deaths[i];
Deaths[i] := Deaths[j];
Deaths[j] := tempint;
end;
end;
end;
// get number censored in each time slot
nopoints := maxtime + 1;
SetLength(Dropped,nopoints+2);
SetLength(Dropped2,nopoints+2);
for j := 0 to nopoints do
begin
Dropped[j] := 0;
Dropped2[j] := 0;
end;
ThisTime := SurvivalTimes[0];
for i := 0 to NoCases do
begin
if (ThisTime = SurvivalTimes[i]) then
begin
if(Censored[i] > 0) then
begin
tempint := SurvivalTimes[i] - mintime;
Dropped[tempint] := Dropped[tempint] + Censored[i];
end;
end
else // new time
begin
ThisTime := SurvivalTimes[i];
if(Censored[i] > 0) then
begin
tempint := SurvivalTimes[i] - mintime;
Dropped[tempint] := Dropped[tempint] + Censored[i];
end;
end;
end;
// calculate expected proportions and adjust survival counts
cumprop := 1.0;
ExpCnt[0] := NoCases;
ExpProp[0] := 1.0;
CumPropExp[0] := 1.0;
// collapse deaths and censored into first time occurance
icase := 0;
oldtime := SurvivalTimes[0];
for i := 1 to NoCases do
begin
if (SurvivalTimes[i] <> oldtime) then
begin
oldtime := SurvivalTimes[i];
icase := i;
end;
// find no. of deaths at this time
NoDeaths := Deaths[i];
for j := i+1 to NoCases do
begin
ThisTime := SurvivalTimes[j];
if ((Deaths[j] > 0) and (oldtime = ThisTime)) then
begin
NoDeaths := NoDeaths + Deaths[j];
Deaths[icase] := Deaths[icase] + Deaths[j];
Deaths[j] := 0;
end;
end;
// find no. of censored at this time
NoCensored := Censored[i];
for j := i+1 to NoCases do
begin
ThisTime := SurvivalTimes[j];
if((Censored[j] > 0) and (oldtime = ThisTime)) then
begin
NoCensored := NoCensored + Censored[j];
Censored[icase] := Censored[icase] + Censored[j];
Censored[j] := 0;
end;
end;
end;
{
// debug check
FrmOutPut.RichOutPut.Clear();
for (int i := 0; i <= NoCases; i++)
begin
sprintf(outline,'case %d Day %d Deaths %d Censored %d',
i,SurvivalTimes[i], Deaths[i],Censored[i]);
FrmOutPut.RichOutPut.Lines.Add(outline);
end;
FrmOutPut.ShowModal();
}
// get no. of categories
for i := 0 to NoCases do
if ((Deaths[i] > 0) or (Censored[i] > 0)) then nocats := nocats + 1;
SetLength(Time,nocats+2);
SetLength(AtRisk,nocats+2);
SetLength(Dead,nocats+2);
SetLength(CondProb,nocats+2);
for i := 0 to nocats do
begin
Time[i] := 0;
AtRisk[i] := 0;
Dead[i] := 0;
CondProb[i] := 0.0;
end;
pos := 0;
for i := 0 to NoCases do
begin
if ((Deaths[i] > 0) or (Censored[i] > 0)) then
begin
pos := pos + 1;
Time[pos] := SurvivalTimes[i];
Dead[pos] := Deaths[i];
Dropped[pos] := Censored[i];
end;
end;
Time[0] := 0;
AtRisk[0] := NoCases;
Dead[0] := 0;
Dropped[0] := 0;
CondProb[0] := 0.0;
OutPutFrm.RichEdit.Clear;
OutPutFrm.RichEdit.Lines.Add(' Time Censored Dead At Risk Probability');
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;
for i := 0 to nocats do
begin
outline := format(' %3d %3d %3d %3d %6.3f',
[Time[i],Dropped[i],Dead[i],AtRisk[i],CondProb[i]]);
OutPutFrm.RichEdit.Lines.Add(outline);
end;
OutPutFrm.ShowModal;
// Get cumulative proportions
for i := 0 to nocats do
begin
if (AtRisk[i] > 0) then
begin
CumPropExp[i] := cumprop * CondProb[i];
cumprop := CumPropExp[i];
end;
end;
cumprop := 1.0;
OutPutFrm.RichEdit.Clear;
OutPutFrm.RichEdit.Lines.Add('Kaplan-Meier Survival Test');
OutPutFrm.RichEdit.Lines.Add('');
OutPutFrm.RichEdit.Lines.Add('No Control Group Method');
OutPutFrm.RichEdit.Lines.Add('');
OutPutFrm.RichEdit.Lines.Add('TIME NO.ALIVE CENSORED DEATHS COND. PROB. CUM.PROP.SURVIVING');
for i := 0 to nocats do
begin
outline := format(' %4d %4d %4d %4d %7.4f %7.4f',
[Time[i],
AtRisk[i],Dropped[i],Deaths[i],CondProb[i],CumPropExp[i]]);
OutPutFrm.RichEdit.Lines.Add(outline);
end;
OutPutFrm.ShowModal;
if (Graph1) then // plot Y := cumulative proportion surviving, x := time
begin
// Get points to plot
nopoints := maxtime + 1;
SetLength(TimePlot,nocats+2);
SetLength(ProbPlot,nocats+2);
ProbPlot[0] := 1.0;
for j := 0 to nocats do
begin
TimePlot[j] := Time[j];
ProbPlot[j] := CumPropExp[j];
end;
BlankFrm.Show;
plotxy(TimePlot, ProbPlot, Dropped, Dropped2,
maxtime,0,1.0, 0.0, nocats,'TIME','PROBABILITY',1);
end; // end if graph1
ProbPlot := nil;
TimePlot := nil;
CondProb := nil;
Dead := nil;
AtRisk := nil;
Time := nil;
end // end if not two groups
//============================================================================//
else // Experimental and control groups
begin
// obtain no. in experimental and control groups
ExpCnt[0] := Size1;
CntrlCnt[0] := Size2;
TotalSize := Size1 + Size2;
CumPropExp[0] := 1.0;
CumPropCntrl[0] := 1.0;
TotalatRisk[0] := TotalSize;
O1 := 0;
O2 := 0;
outline := format('Total Group 1 := %d, Total Group 2 := %d, Grand Total := %d',
[ExpCnt[0], CntrlCnt[0], TotalSize]);
ShowMessage(outline);
// Now read values. Note storage starts in 1, not 0!
for i := 1 to NoCases do
begin
SurvivalTimes[i] := StrToInt(OS3MainFrm.DataGrid.Cells[TimeCol,i]);
if (SurvivalTimes[i] > maxtime) then maxtime := SurvivalTimes[i];
tempvalue := StrToInt(OS3MainFrm.DataGrid.Cells[DeathsCol,i]);
if (tempvalue = 1) then Deaths[i] := 1 else Deaths[i] := 0;
if (tempvalue = 2) then Censored[i] := 1 else Censored[i] := 0;
Group[i] := StrToInt(OS3MainFrm.DataGrid.Cells[GroupCol,i]);
end;
// sort cases by time
for i := 1 to NoCases - 1 do
begin
for j := i + 1 to NoCases do
begin
if (SurvivalTimes[i] > SurvivalTimes[j]) then
begin
tempint := SurvivalTimes[i];
SurvivalTimes[i] := SurvivalTimes[j];
SurvivalTimes[j] := tempint;
tempint := Censored[i];
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;
// sort cases within each time slot by deaths first then censored
ThisTime := SurvivalTimes[1];
first := 1;
last := 1;
for i := 1 to NoCases do
begin
if (ThisTime = SurvivalTimes[i]) then
begin
last := i;
continue;
end
else // sort the cases from first to last on event (descending)
begin
if (last > first) then // more than 1 to sort
begin
for j := first to last - 1 do
begin
for k := j + 1 to last do
begin
if (Deaths[j] < Deaths[k] ) then // swap
begin
tempint := Censored[j];
Censored[j] := Censored[k];
Censored[k] := tempint;
tempint := Deaths[j];
Deaths[j] := Deaths[k];
Deaths[k] := tempint;
tempint := Group[j];
Group[j] := Group[k];
Group[k] := tempint;
end;
end; // next k
end; // next j
end; // if last > first
end; // end else sort
first := last + 1;
ThisTime := SurvivalTimes[first];
last := first;
end; // next i
// get number censored in each time slot
nopoints := maxtime + 1;
SetLength(Dropped,nopoints+2);
SetLength(Dropped2,nopoints+2);
for j := 0 to nopoints do
begin
Dropped[j] := 0;
Dropped2[j] := 0;
end;
ThisTime := SurvivalTimes[1];
for i := 1 to NoCases do
begin
if (ThisTime = SurvivalTimes[i]) then
begin
if(Censored[i] > 0) then
begin
tempint := SurvivalTimes[i] - mintime;
if (Group[i] = 1) then
Dropped[tempint] := Dropped[tempint] + Censored[i]
else Dropped2[tempint] := Dropped2[tempint] + Censored[i];
end;
end
else // new time
begin
ThisTime := SurvivalTimes[i];
if(Censored[i] > 0) then
begin
tempint := SurvivalTimes[i] - mintime;
if (Group[i] = 1) then
Dropped[tempint] := Dropped[tempint] + Censored[i]
else Dropped2[tempint] := Dropped2[tempint] + Censored[i];
end;
end;
end;
for i := 0 to NoCases do
begin
noinexp := 0;
noincntrl := 0;
if (Deaths[i] > 0) then
begin
// find no. of deaths at this time
NoDeaths := Deaths[i];
ThisTime := SurvivalTimes[i];
for j := i+1 to NoCases do
begin
if ((Deaths[j] > 0) and (SurvivalTimes[j] = ThisTime)) then
begin
NoDeaths := NoDeaths + Deaths[j];
Deaths[i] := Deaths[i] + Deaths[j];
Deaths[j] := 0;
end;
end;
if (TotalatRisk[i] > 0) then
begin
term1 := ExpCnt[i];
term2 := TotalatRisk[i];
term3 := NoDeaths;
ExpatRisk[i] := ceil((term1 / term2) * term3);
// ExpatRisk[i] := (ExpCnt[i]) / TotalatRisk[i]) * NoDeaths;
term1 := CntrlCnt[i];
CntrlatRisk[i] := ceil((term1 / term2) * term3);
// CntrlatRisk[i] := (CntrlCnt[i] / TotalatRisk[i]) * NoDeaths;
end;
if (i < NoCases-1) then TotalatRisk[i+1] := TotalatRisk[i] - Deaths[i];
// find no. in exp. or control groups and decrement their counts
for j := 1 to NoCases do
begin
if ( (ThisTime = SurvivalTimes[j]) and (Censored[j] = 0)) then
begin
if (Group[j] = 1) then
begin
noinexp := noinexp + 1;
O1 := O1 + 1;
end;
if (Group[j] = 2) then
begin
noincntrl := noincntrl + 1;
O2 := O2 + 1;
end;
end;
end;
if ( (i < NoCases) and (noinexp > 0) ) then
begin
term1 := ExpCnt[i];
term2 := noinexp;
term3 := ExpCnt[i];
ExpProp[i] := (term1 - term2) / term3;
// ExpProp[i] := (ExpCnt[i] - noinexp) / ExpCnt[i];
if (i > 0) then CumPropExp[i] := CumPropExp[i-1] * ExpProp[i];
ExpCnt[i+1] := ExpCnt[i] - noinexp;
CumPropExp[i+1] := CumPropExp[i];
end;
if ( (i < NoCases) and (noinexp = 0) ) then
begin
ExpCnt[i+1] := ExpCnt[i];
CumPropExp[i+1] := CumPropExp[i];
end;
if ( (i < NoCases) and (noincntrl > 0) ) then
begin
term1 := CntrlCnt[i];
term2 := noincntrl;
term3 := CntrlCnt[i];
CntrlProp[i] := (term1 - term2) / term3;
// CntrlProp[i] := (CntrlCnt[i] - noincntrl) / CntrlCnt[i];
if (i > 0) then CumPropCntrl[i] := CumPropCntrl[i-1] * CntrlProp[i];
CntrlCnt[i+1] := CntrlCnt[i] - noincntrl;
CumPropCntrl[i+1] := CumPropCntrl[i];
end;
if ( (i < NoCases) and (noincntrl = 0) ) then
begin
CntrlCnt[i+1] := CntrlCnt[i];
CumPropCntrl[i+1] := CumPropCntrl[i];
end;
end; // end if deaths[i] > 0
if ( (Censored[i] > 0) and (i < NoCases) ) then
begin
if (Group[i] = 1) then
begin
ExpCnt[i+1] := ExpCnt[i] - 1;
CntrlCnt[i+1] := CntrlCnt[i];
ExpProp[i+1] := ExpProp[i];
CumPropExp[i+1] := CumPropExp[i];
CumPropCntrl[i+1] := CumPropCntrl[i];
end;
if (Group[i] = 2) then
begin
CntrlCnt[i+1] := CntrlCnt[i] - 1;
ExpCnt[i+1] := ExpCnt[i];
CntrlProp[i+1] := CntrlProp[i];
CumPropCntrl[i+1] := CumPropCntrl[i];
CumPropExp[i+1] := CumPropExp[i];
end;
TotalatRisk[i+1] := TotalatRisk[i] - 1;
end;
if ( (Deaths[i] = 0) and (Censored[i] = 0) and (i < NoCases) ) then
begin
ExpCnt[i+1] := ExpCnt[i];
CntrlCnt[i+1] := CntrlCnt[i];
CumPropExp[i+1] := CumPropExp[i];
CumPropCntrl[i+1] := CumPropCntrl[i];
TotalatRisk[i+1] := TotalatRisk[i];
end;
end; // next case i
// Now calculate chisquare, relative risk (r), logr, and S.E. of log risk
E1 := 0.0;
for i := 0 to NoCases do E1 := E1 + ExpatRisk[i];
E2 := (O1 + O2) - E1;
Chisquare := ((O1 - E1) * (O1 - E1)) / E1 + ((O2 - E2) * (O2 - E2)) / E2;
ProbChi := chisquaredprob(Chisquare,1);
Risk := (O1 / E1) / (O2 / E2);
LogRisk := ln(Risk);
SELogRisk := sqrt(1.0/E1 + 1.0/E2);
HiConf := LogRisk + (inversez(0.975) * SELogRisk);
LowConf := LogRisk - (inversez(0.975) * SELogRisk);
HiLogLevel := exp(HiConf);
LowLogLevel := exp(LowConf);
end;
// Print Results
if (TwoGroups and PrintIt) then // both experimental and control groups
begin
OutPutFrm.RichEdit.Clear;
OutPutFrm.RichEdit.Lines.Add('Kaplan-Meier Survival Test');
OutPutFrm.RichEdit.Lines.Add('');
OutPutFrm.RichEdit.Lines.Add('Comparison of Two Groups Methd');
OutPutFrm.RichEdit.Lines.Add('');
OutPutFrm.RichEdit.Lines.Add('TIME GROUP CENSORED TOTAL AT EVENTS AT RISK IN EXPECTED NO. AT RISK IN EXPECTED NO.');
OutPutFrm.RichEdit.Lines.Add(' RISK GROUP 1 EVENTS IN 1 GROUP 2 EVENTS IN 2');
for i := 1 to NoCases+1 do
begin
outline := format('%4d %4d %4d %4d %4d %4d %7d %4d %7d',
[SurvivalTimes[i-1],Group[i-1],Censored[i-1],TotalatRisk[i-1],
Deaths[i-1],ExpCnt[i-1],ExpatRisk[i-1],CntrlCnt[i-1],CntrlatRisk[i-1]]);
OutPutFrm.RichEdit.Lines.Add(outline);
end;
OutPutFrm.RichEdit.Lines.Add('');
OutPutFrm.RichEdit.Lines.Add('');
OutPutFrm.RichEdit.Lines.Add('TIME DEATHS GROUP AT RISK PROPORTION CUMULATIVE');
OutPutFrm.RichEdit.Lines.Add(' SURVIVING PROP.SURVIVING');
for i := 1 to NoCases do
begin
if (Group[i] = 1) then
begin
count := ExpCnt[i];
proportion := ExpProp[i];
cumprop := CumPropExp[i];
end
else
begin
count := CntrlCnt[i];
proportion := CntrlProp[i];
cumprop := CumPropCntrl[i];
end;
outline := format('%4d %4d %4d %4d %7.4f %7.4f',
[SurvivalTimes[i],Deaths[i],Group[i],count,proportion,cumprop]);
OutPutFrm.RichEdit.Lines.Add(outline);
end;
OutPutFrm.RichEdit.Lines.Add('');
outline := format('Total Expected Events for Experimental Group := %8.3f',[E1]);
OutPutFrm.RichEdit.Lines.Add(outline);
outline := format('Observed Events for Experimental Group := %8.3f',[O1]);
OutPutFrm.RichEdit.Lines.Add(outline);
outline := format('Total Expected Events for Control Group := %8.3f',[E2]);
OutPutFrm.RichEdit.Lines.Add(outline);
outline := format('Observed Events for Control Group := %8.3f',[O2]);
OutPutFrm.RichEdit.Lines.Add(outline);
outline := format('Chisquare = %8.3f with probability = %5.3f',[Chisquare,ProbChi]);
OutPutFrm.RichEdit.Lines.Add(outline);
outline := format('Risk := %8.3f, Log Risk := %8.3f, Std.Err. Log Risk := %8.3f',
[Risk, LogRisk, SELogRisk]);
OutPutFrm.RichEdit.Lines.Add(outline);
outline := format('95 Percent Confidence interval for Log Risk = (%5.3f,%5.3f)',
[LowConf,HiConf]);
OutPutFrm.RichEdit.Lines.Add(outline);
outline := format('95 Percent Confidence interval for Risk := (%5.3f,%5.3f)',
[LowLogLevel,HiLogLevel]);
OutPutFrm.RichEdit.Lines.Add(outline);
OutPutFrm.ShowModal;
// Plot data output
OutPutFrm.RichEdit.Clear;
OutPutFrm.RichEdit.Lines.Add('EXPERIMENTAL GROUP CUMULATIVE PROBABILITY');
OutPutFrm.RichEdit.Lines.Add('CASE TIME DEATHS CENSORED CUM.PROB.');
for i := 1 to NoCases do
begin
if (Group[i] = 1) then
begin
outline := format('%3d %3d %3d %3d %5.3f',[i,
SurvivalTimes[i], Deaths[i], Censored[i], CumPropExp[i]]);
OutPutFrm.RichEdit.Lines.Add(outline);
end;
end;
OutPutFrm.RichEdit.Lines.Add('');
OutPutFrm.ShowModal;
OutPutFrm.RichEdit.Clear;
OutPutFrm.RichEdit.Lines.Add('CONTROL GROUP CUMULATIVE PROBABILITY');
OutPutFrm.RichEdit.Lines.Add('CASE TIME DEATHS CENSORED CUM.PROB.');
for i := 1 to NoCases do
begin
if (Group[i] = 2) then
begin
outline := format('%3d %3d %3d %3d %5.3f',[i,
SurvivalTimes[i], Deaths[i], Censored[i], CumPropCntrl[i]]);
OutPutFrm.RichEdit.Lines.Add(outline);
end;
end;
OutPutFrm.RichEdit.Lines.Add('');
OutPutFrm.ShowModal;
end; // if 2 groups and printit
if (Graph1) then // plot cumulative proportion surviving (Y) against time (X)
begin
nopoints := maxtime + 1;
SetLength(TimePlot,nopoints+2);
SetLength(ProbPlot,nopoints+2);
SetLength(ProbPlot2,nopoints+2);
ProbPlot[0] := 1.0;
ProbPlot2[0] := 1.0;
lastexp := 1.0;
lastctr := 1.0;
for i := 0 to nopoints do
begin
TimePlot[i] := 0;
ProbPlot[i] := 1.0;
ProbPlot2[i] := 1.0;
end;
TimePlot[0] := 0;
mintime := 0;
for i := 1 to nopoints do
begin
TimePlot[i] := i;
for j := 1 to NoCases do
begin
if (SurvivalTimes[j] = i) then
begin
if (Group[j] = 1) then
begin
ProbPlot[i] := CumPropExp[j]; // ExpProp[j];
lastexp := CumPropExp[j]; // ExpProp[j];
end;
if (Group[j] = 2) then
begin
ProbPlot2[i] := CumPropCntrl[j]; //CntrlProp[j];
lastctr := CumPropCntrl[j]; // CntrlProp[j];
end;
end
else
begin
if (Group[j] = 1) then ProbPlot[i] := lastexp;
if (Group[j] = 2) then ProbPlot2[i] := lastctr;
end;
end;
end;
BlankFrm.Image1.Canvas.Clear;
BlankFrm.Show;
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;
procedure TKaplanMeierFrm.EventOutBtnClick(Sender: TObject);
begin
VarList.Items.Add(EventEdit.Text);
EventEdit.Text := '';
EventInBtn.Visible := true;
EventOutBtn.Visible := false;
end;
procedure TKaplanMeierFrm.plotxy(var Xpoints: IntDyneVec;
var Ypoints: DblDyneVec; var Dropped: IntDyneVec; var Dropped2: IntDyneVec;
Xmax, Xmin, Ymax, Ymin: double; N: integer; XEdit: string; YEdit: string;
curveno: integer);
var
i, xpos, ypos, hleft, hright, vtop, vbottom, imagewide : integer;
vhi, hwide, offset, strhi, imagehi : integer;
noxvalues, digitwidth, Xvalue, xvalincr, oldxpos : integer;
maxval, minval, valincr, Yvalue, value, oldypos, term1, term2, term3 : double;
Title, outline : string;
label again, second;
begin
if (curveno = 2) then goto second;
BlankFrm.Image1.Canvas.Font.Color := clBlack;
Title := 'SURVIVAL CURVE';
BlankFrm.Caption := Title;
imagewide := BlankFrm.Image1.Width;
imagehi := BlankFrm.Image1.Height;
BlankFrm.Image1.Canvas.FloodFill(0,0,clWhite,fsBorder);
vtop := 20;
vbottom := ceil(imagehi) - 130;
vhi := vbottom - vtop;
hleft := 100;
hright := imagewide - 80;
hwide := hright - hleft;
BlankFrm.Image1.Canvas.Pen.Color := clBlack;
BlankFrm.Image1.Canvas.Brush.Color := clWhite;
// Draw chart border
// ImageFrm.Image.Canvas.Rectangle(0,0,imagewide,imagehi);
// draw horizontal axis
noxvalues := N;
xvalincr := 1;
digitwidth := BlankFrm.Image1.Canvas.TextWidth('9');
again:
if ( (noxvalues * 4 * digitwidth) > hwide) then
begin
noxvalues := noxvalues div 2;
xvalincr := 2 * xvalincr;
goto again;
end;
BlankFrm.Image1.Canvas.Pen.Style := psSolid;
BlankFrm.Image1.Canvas.Pen.Color := clBlack;
BlankFrm.Image1.Canvas.MoveTo(hleft,vbottom);
BlankFrm.Image1.Canvas.LineTo(hright,vbottom);
for i := 1 to noxvalues do
begin
ypos := vbottom;
Xvalue := Xpoints[1] + xvalincr * (i - 1); // Xmin + xvalincr * (i - 1);
term1 := (Xvalue - Xmin) / (Xmax - Xmin);
term2 := hwide;
term3 := hleft;
xpos := floor((term1 * term2) + term3);
BlankFrm.Image1.Canvas.MoveTo(xpos,ypos);
ypos := ypos + 10;
BlankFrm.Image1.Canvas.LineTo(xpos,ypos);
outline := format('%d',[Xvalue]);
Title := outline;
offset := BlankFrm.Image1.Canvas.TextWidth(Title) div 2;
xpos := xpos - offset;
BlankFrm.Image1.Canvas.Pen.Color := clBlack;
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title);
end;
xpos := hleft + (hwide div 2) - (BlankFrm.Image1.Canvas.TextWidth(XEdit) div 2);
ypos := vbottom + 22;
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,XEdit);
// Draw vertical axis
Title := YEdit;
xpos := hleft - BlankFrm.Image1.Canvas.TextWidth(Title) div 2;
ypos := vtop - BlankFrm.Image1.Canvas.TextHeight(Title);
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,YEdit);
xpos := hleft;
ypos := vtop;
BlankFrm.Image1.Canvas.MoveTo(xpos,ypos);
ypos := vbottom;
BlankFrm.Image1.Canvas.LineTo(xpos,ypos);
valincr := (Ymax - Ymin) / 10.0;
for i := 1 to 11 do
begin
value := Ymax - ((i-1) * valincr);
outline := format('%8.2f',[value]);
Title := outline;
strhi := BlankFrm.Image1.Canvas.TextHeight(Title);
xpos := 10;
Yvalue := Ymax - (valincr * (i-1));
ypos := ceil(vhi * ( (Ymax - Yvalue) / (Ymax - Ymin)));
ypos := ypos + vtop - strhi div 2;
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title);
xpos := hleft;
ypos := ypos + strhi div 2;
BlankFrm.Image1.Canvas.MoveTo(xpos,ypos);
xpos := hleft - 10;
BlankFrm.Image1.Canvas.LineTo(xpos,ypos);
end;
// get xpos and ypos for first point to second point
second: xpos := hleft;
ypos := vtop;
BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); // Probability := 1 at time 0
if (curveno = 1) then BlankFrm.Image1.Canvas.Pen.Color := clNavy
else BlankFrm.Image1.Canvas.Pen.Color := clRed;
ypos := ceil(vhi * ( (Ymax - Ypoints[0]) / (Ymax - Ymin)));
ypos := ypos + vtop;
xpos := ceil(hwide * ( (Xpoints[1] - Xmin) / (Xmax - Xmin)));
xpos := xpos + hleft;
BlankFrm.Image1.Canvas.LineTo(xpos,ypos);
// draw points for x and y pairs
oldxpos := xpos;
oldypos := ypos;
for i := 1 to N - 1 do
begin
ypos := ceil(vhi * ( (Ymax - Ypoints[i]) / (Ymax - Ymin)));
ypos := ypos + vtop;
if (ypos <> oldypos) then // draw line down to new ypos using old xpos
begin
if (curveno = 1) then BlankFrm.Image1.Canvas.Pen.Style := psSolid
else BlankFrm.Image1.Canvas.Pen.Style := psDot;
BlankFrm.Image1.Canvas.LineTo(oldxpos,ypos);
end;
xpos := ceil(hwide * ( (Xpoints[i] - Xmin) / (Xmax - Xmin)));
xpos := xpos + hleft;
oldxpos := xpos;
oldypos := ypos;
BlankFrm.Image1.Canvas.Pen.Style := psSolid;
BlankFrm.Image1.Canvas.LineTo(xpos,ypos);
end;
// show censored
BlankFrm.Image1.Canvas.Pen.Style := psSolid;
BlankFrm.Image1.Canvas.Pen.Color := clBlack;
for i := 1 to N do
begin
if ((Dropped[i] = 0) and (curveno = 1)) then continue;
if ((Dropped2[i] = 0) and (curveno = 2)) then continue;
if (curveno = 1) then
begin
BlankFrm.Image1.Canvas.Font.Color := clNavy;
ypos := vbottom + 35;
xpos := ceil(hwide * ((Xpoints[i] - Xmin) / (Xmax - Xmin)));
xpos := xpos + hleft;
outline := format('%d',[Dropped[i]]);
Title := outline;
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title);
end
else
begin
BlankFrm.Image1.Canvas.Font.Color := clRed;
ypos := vbottom + 48;
xpos := ceil(hwide * ((Xpoints[i] - Xmin) / (Xmax - Xmin)));
xpos := xpos + hleft;
outline := format('%d',[Dropped2[i]]);
Title := outline;
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title);
end;
end;
BlankFrm.Image1.Canvas.Font.Color := clBlack;
ypos := vbottom + 60;
Title := 'NUMBER CENSORED';
xpos := hleft + (hwide div 2) - (BlankFrm.Image1.Canvas.TextWidth(Title) div 2);
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title);
BlankFrm.Image1.Canvas.Font.Color := clNavy;
Title := 'EXPERIMENTAL';
xpos := 5;
ypos := vbottom + 35;
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title);
if (curveno = 2) then
begin
BlankFrm.Image1.Canvas.Font.Color := clRed;
Title := 'CONTROL';
xpos := 5;
ypos := vbottom + 48;
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title);
end;
end;
initialization
{$I kaplanmeierunit.lrs}
end.
Reference in New Issue View Git Blame Copy Permalink