pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity
Files
b98f47bf19a2b896f78f7fc9cbeabd9a38d6e520
lazarus-ccr/applications/lazstats/source/forms/analysis/nonparametric/kaplanmeierunit.pas
wp_xxyyzz 06a2f4ff97 LazStats: Refactoring of TwoCorrsUnit. Less hints and warnings. 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7846 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2020-11-06 00:04:57 +00:00

1041 lines
30 KiB
ObjectPascal
Raw Blame History

unit KaplanMeierUnit;
{$mode objfpc}{$H+}
{$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
StdCtrls, ExtCtrls, Buttons, Clipbrd,
TASources, TAChartAxis,
MainUnit, Globals, FunctionsLib, BasicStatsReportAndChartFormUnit;
type
{ TKaplanMeierForm }
TKaplanMeierForm = class(TBasicStatsReportAndChartForm)
TimeInBtn: TBitBtn;
TimeOutBtn: TBitBtn;
EventInBtn: TBitBtn;
EventOutBtn: TBitBtn;
GroupInBtn: TBitBtn;
GroupOutBtn: TBitBtn;
TimeVarEdit: TEdit;
Label1: TLabel;
TimeVarLabel: TLabel;
EventVarLabel: TLabel;
GroupVarLabel: TLabel;
EventVarEdit: TEdit;
GroupVarEdit: TEdit;
VarList: TListBox;
procedure EventInBtnClick(Sender: TObject);
procedure EventOutBtnClick(Sender: TObject);
procedure GroupInBtnClick(Sender: TObject);
procedure GroupOutBtnClick(Sender: TObject);
procedure TimeInBtnClick(Sender: TObject);
procedure TimeOutBtnClick(Sender: TObject);
procedure VarListDblClick(Sender: TObject);
procedure VarListSelectionChange(Sender: TObject; {%H-}User: boolean);
private
FExperimentalAxis: TChartAxis;
FControlAxis: TChartAxis;
FExperimentalSource: TListChartSource;
FControlSource: TListChartSource;
procedure PlotXY(const XPoints: IntDyneVec; const Y1Points, Y2Points: DblDyneVec;
const Dropped, Dropped2: IntDyneVec; N: Integer);
protected
procedure AdjustConstraints; override;
procedure Compute; override;
procedure UpdateBtnStates; override;
public
constructor Create(AOwner: TComponent); override;
procedure Reset; override;
end;
var
KaplanMeierForm: TKaplanMeierForm;
implementation
{$R *.lfm}
uses
Math,
TAChartUtils, TAChartAxisUtils, TACustomSeries,
GridProcs, {BlankFrmUnit, } MatrixUnit, ChartFrameUnit;
const
EXPERIMENTAL_CAPTION = 'Experimental';
CONTROL_CAPTION = 'Control';
{ TKaplanMeierForm }
constructor TKaplanMeierForm.Create(AOwner: TComponent);
begin
inherited;
{
if BlankFrm = nil then
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;
procedure TKaplanMeierForm.AdjustConstraints;
begin
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;
procedure TKaplanMeierForm.GroupInBtnClick(Sender: TObject);
var
i: integer;
begin
i := VarList.ItemIndex;
if (i > -1) and (GroupVarEdit.Text = '') then
begin
GroupVarEdit.Text := VarList.Items[i];
VarList.Items.Delete(i);
end;
UpdateBtnStates;
end;
procedure TKaplanMeierForm.GroupOutBtnClick(Sender: TObject);
begin
if GroupVarEdit.Text <> '' then
begin
VarList.Items.Add(GroupVarEdit.Text);
GroupVarEdit.Text := '';
end;
UpdateBtnStates;
end;
procedure TKaplanMeierForm.EventInBtnClick(Sender: TObject);
var
i: integer;
begin
i := VarList.ItemIndex;
if (i > -1) and (EventVarEdit.Text = '') then
begin
EventVarEdit.Text := VarList.Items[i];
VarList.Items.Delete(i);
end;
UpdateBtnStates;
end;
procedure TKaplanMeierForm.EventOutBtnClick(Sender: TObject);
begin
if EventVarEdit.Text <> '' then
begin
VarList.Items.Add(EventVarEdit.Text);
EventVarEdit.Text := '';
end;
UpdateBtnStates;
end;
procedure TKaplanMeierForm.Compute;
var
TwoGroups : boolean;
Size1, Size2, TotalSize, NoDeaths, ThisTime: integer;
minTime, maxTime, tempInt, noPoints, tempValue: integer;
NoCensored, noCats, i, j, k, icase, oldtime, pos, first, last : integer;
noinexp, noincntrl, count, TimeCol, DeathsCol: integer;
GroupCol : integer;
cumprop, proportion, term1, term2, term3 : double;
E1, E2, O1, O2, Chisquare, ProbChi, Risk, LogRisk, SELogRisk : double;
HiConf, LowConf, HiLogLevel, LowLogLevel, lastexp, lastctr : double;
TimePlot: IntDyneVec = nil;
Dropped: IntDyneVec = nil;
Dropped2: IntDyneVec = nil;
Time: IntDyneVec = nil;
AtRisk: IntDyneVec = nil;
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;
lReport: TStrings;
begin
// Get variable columns
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
MessageDlg('One or more variables not selected.', mtError, [mbOK], 0);
exit;
end;
if (GroupVarEdit.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;
// Get Data
mintime := 0;
maxtime := 0;
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
Exchange(SurvivalTimes[i], SurvivalTimes[j]);
Exchange(Censored[i], Censored[j]);
Exchange(Deaths[i], Deaths[j]);
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
nocats := 0;
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;
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;
try
lReport.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
lReport.Add(' %3d %3d %3d %3d %6.3f', [Time[i], Dropped[i], Dead[i], AtRisk[i], CondProb[i]]);
DisplayReport(lReport);
finally
lReport.Free;
end;
*)
// 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;
lReport := TStringList.Create;
try
lReport.Add('KAPLAN-MEIER SURVIVAL TEST');
lReport.Add('');
lReport.Add('No Control Group Method');
lReport.Add('');
lReport.Add('TIME NO.ALIVE CENSORED DEATHS COND. PROB. CUM.PROP.SURVIVING');
for i := 0 to nocats do
lReport.Add(' %4d %4d %4d %4d %7.4f %7.4f', [
Time[i], AtRisk[i], Dropped[i], Deaths[i], CondProb[i], CumPropExp[i]
]);
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
lReport.Free;
end;
// Plot X = Time, Y = cumulative proportion surviving
// 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;
PlotXY(TimePlot, ProbPlot, nil, Dropped, Dropped, NoCats);
// BlankFrm.Show;
// PlotXY(TimePlot, ProbPlot, Dropped, Dropped2, maxtime, 0, 1.0, 0.0, nocats, 'TIME', 'PROBABILITY', 1);
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;
{
ShowMessage(Format('Total Group 1 = %d, Total Group 2 = %d, Grand Total = %d',
[ ExpCnt[0], CntrlCnt[0], TotalSize ]));
}
// 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
Exchange(SurvivalTimes[i], SurvivalTimes[j]);
Exchange(Censored[i], Censored[j]);
Exchange(Deaths[i], Deaths[j]);
Exchange(Group[i], Group[j]);
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
Exchange(Censored[j], Censored[k]);
Exchange(Deaths[j], Deaths[k]);
Exchange(Group[j], Group[k]);
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 then // both experimental and control groups
begin
lReport := TStringList.Create;
try
lReport.Add('KAPLAN-MEIER SURVIVAL TEST');
lReport.Add('');
lReport.Add('Comparison of Two Groups Methd');
lReport.Add('');
lReport.Add('TIME GROUP CENSORED TOTAL AT EVENTS AT RISK IN EXPECTED NO. AT RISK IN EXPECTED NO.');
lReport.Add(' RISK GROUP 1 EVENTS IN 1 GROUP 2 EVENTS IN 2');
for i := 1 to NoCases+1 do
lReport.Add('%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]
]);
lReport.Add('');
lReport.Add('');
lReport.Add('TIME DEATHS GROUP AT RISK PROPORTION CUMULATIVE');
lReport.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;
lReport.Add('%4d %4d %4d %4d %7.4f %7.4f', [
SurvivalTimes[i], Deaths[i], Group[i], count, proportion, cumprop
]);
end;
lReport.Add('');
lReport.Add('Total Expected Events for Experimental Group: %8.3f', [E1]);
lReport.Add('Observed Events for Experimental Group: %8.3f', [O1]);
lReport.Add('Total Expected Events for Control Group: %8.3f', [E2]);
lReport.Add('Observed Events for Control Group: %8.3f', [O2]);
lReport.Add('Chisquare: %8.3f', [ChiSquare]);
lReport.Add(' with probability: %8.3f', [ProbChi]);
lReport.Add('Risk: %8.3f', [Risk]);
lReport.Add('Log Risk: %8.3f', [LogRisk]);
lReport.Add('Std.Err. Log Risk: %8.3f', [SELogRisk]);
lReport.Add('95 Percent Confidence interval for Log Risk: (%.3f ... %.3f)', [LowConf, HiConf]);
lReport.Add('95 Percent Confidence interval for Risk: (%.3f ... %.3f)', [LowLogLevel, HiLogLevel]);
// Plot data output
lReport.Add('');
lReport.Add(DIVIDER_AUTO);
lReport.Add('');
lReport.Add('EXPERIMENTAL GROUP CUMULATIVE PROBABILITY');
lReport.Add('');
lReport.Add('CASE TIME DEATHS CENSORED CUM.PROB.');
for i := 1 to NoCases do
if (Group[i] = 1) then
lReport.Add('%3d %3d %3d %3d %5.3f',[
i, SurvivalTimes[i], Deaths[i], Censored[i], CumPropExp[i]
]);
lReport.Add('');
lReport.Add(DIVIDER_AUTO);
lReport.Add('');
lReport.Add('CONTROL GROUP CUMULATIVE PROBABILITY');
lReport.Add('');
lReport.Add('CASE TIME DEATHS CENSORED CUM.PROB.');
for i := 1 to NoCases do
if (Group[i] = 2) then
lReport.Add('%3d %3d %3d %3d %5.3f', [
i, SurvivalTimes[i], Deaths[i], Censored[i], CumPropCntrl[i]
]);
lReport.Add('');
FReportFrame.DisplayReport(lReport);
finally
lReport.Free;
end;
end; // if 2 groups and printit
// Plot cumulative proportion surviving (Y) against time (X)
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;
PlotXY(TimePlot, ProbPlot, ProbPlot2, Dropped, Dropped2, NoPoints);
// 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);
end;
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.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
lSelected: Boolean;
i: Integer;
begin
inherited;
lSelected := false;
for i := 0 to VarList.Count-1 do
if VarList.Selected[i] then
begin
lSelected := true;
break;
end;
TimeInBtn.Enabled := lSelected and (TimeVarEdit.Text = '');
EventInBtn.Enabled := lSelected and (EventVarEdit.Text = '');
GroupInBtn.Enabled := lSelected and (GroupVarEdit.Text = '');
TimeOutBtn.Enabled := (TimeVarEdit.Text <> '');
EventOutBtn.Enabled := (EventVarEdit.Text <> '');
GroupOutBtn.Enabled := (GroupVarEdit.Text <> '');
end;
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
UpdateBtnStates;
end;
end.
Reference in New Issue View Git Blame Copy Permalink