You've already forked lazarus-ccr
03efb4e2b9
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8017 8e941d3f-bd1b-0410-a28a-d453659cc2b4
446 lines
11 KiB
ObjectPascal
446 lines
11 KiB
ObjectPascal
unit LifeTableUnit;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
|
StdCtrls, Buttons, ExtCtrls, Grids,
|
|
MainUnit, Globals, FunctionsLib, GraphLib, BasicStatsParamsFormUnit;
|
|
|
|
type
|
|
|
|
{ TLifeTableForm }
|
|
|
|
TLifeTableForm = class(TBasicStatsParamsForm)
|
|
Bevel1: TBevel;
|
|
CIEdit: TEdit;
|
|
Label7: TLabel;
|
|
NoCensoredEdit: TEdit;
|
|
Label6: TLabel;
|
|
NoDiedEdit: TEdit;
|
|
Label5: TLabel;
|
|
NoAliveEdit: TEdit;
|
|
Label4: TLabel;
|
|
ObsEndEdit: TEdit;
|
|
Label3: TLabel;
|
|
ObsStartEdit: TEdit;
|
|
Label2: TLabel;
|
|
ObsStartInBtn: TBitBtn;
|
|
ObsEndInBtn: TBitBtn;
|
|
AliveInBtn: TBitBtn;
|
|
NoDiedInBtn: TBitBtn;
|
|
NoCensoredInBtn: TBitBtn;
|
|
ObsStartOutBtn: TBitBtn;
|
|
ObsEndOutBtn: TBitBtn;
|
|
AliveOutBtn: TBitBtn;
|
|
NoDiedOutBtn: TBitBtn;
|
|
NoCensoredOutBtn: TBitBtn;
|
|
Panel2: TPanel;
|
|
Label1: TLabel;
|
|
Grid: TStringGrid;
|
|
Splitter1: TSplitter;
|
|
VarList: TListBox;
|
|
procedure AliveInBtnClick(Sender: TObject);
|
|
procedure AliveOutBtnClick(Sender: TObject);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure GridPrepareCanvas(Sender: TObject; ACol, aRow: Integer;
|
|
AState: TGridDrawState);
|
|
procedure NoCensoredInBtnClick(Sender: TObject);
|
|
procedure NoCensoredOutBtnClick(Sender: TObject);
|
|
procedure NoDiedInBtnClick(Sender: TObject);
|
|
procedure NoDiedOutBtnClick(Sender: TObject);
|
|
procedure ObsEndInBtnClick(Sender: TObject);
|
|
procedure ObsEndOutBtnClick(Sender: TObject);
|
|
procedure ObsStartInBtnClick(Sender: TObject);
|
|
procedure ObsStartOutBtnClick(Sender: TObject);
|
|
procedure VarListDblClick(Sender: TObject);
|
|
procedure VarListSelectionChange(Sender: TObject; User: boolean);
|
|
private
|
|
{ private declarations }
|
|
protected
|
|
procedure AdjustConstraints; override;
|
|
procedure Compute; override;
|
|
procedure UpdateBtnStates; override;
|
|
function Validate(out AMsg: String; out AControl: TWinControl): Boolean; override;
|
|
public
|
|
procedure Reset; override;
|
|
end;
|
|
|
|
var
|
|
LifeTableForm: TLifeTableForm;
|
|
|
|
implementation
|
|
|
|
{$R *.lfm}
|
|
|
|
uses
|
|
Math,
|
|
GridProcs;
|
|
|
|
|
|
{ TLifeTableForm }
|
|
|
|
procedure TLifeTableForm.AdjustConstraints;
|
|
begin
|
|
ParamsPanel.Constraints.MinWidth :=
|
|
MaxValue([
|
|
Label2.Canvas.TextWidth(Label2.Caption),
|
|
Label3.Canvas.TextWidth(Label3.Caption),
|
|
Label4.Canvas.TextWidth(Label4.Caption),
|
|
Label5.Canvas.TextWidth(Label5.Caption),
|
|
Label6.Canvas.Textwidth(Label6.Caption),
|
|
Label7.canvas.TextWidth('Confidence Level') + Label7.BorderSpacing.Right + CIEdit.Width]) * 2 +
|
|
ObsStartInBtn.Width + VarList.BorderSpacing.Right * 2;
|
|
|
|
ParamsPanel.Constraints.MinHeight :=
|
|
CIEdit.Top + CIEdit.Height + CIEdit.BorderSpacing.Bottom +
|
|
ButtonBevel.Height +
|
|
CloseBtn.BorderSpacing.Top + CloseBtn.Height;
|
|
end;
|
|
|
|
|
|
procedure TLifeTableForm.AliveInBtnClick(Sender: TObject);
|
|
var
|
|
index: integer;
|
|
begin
|
|
index := VarList.ItemIndex;
|
|
if (index > -1) and (NoAliveEdit.Text = '') then
|
|
begin
|
|
NoAliveEdit.Text := VarList.Items[index];
|
|
VarList.Items.Delete(index);
|
|
end;
|
|
UpdateBtnStates;
|
|
end;
|
|
|
|
|
|
procedure TLifeTableForm.AliveOutBtnClick(Sender: TObject);
|
|
begin
|
|
if NoAliveEdit.Text <> '' then
|
|
begin
|
|
VarList.Items.Add(NoAliveEdit.Text);
|
|
NoAliveEdit.Text := '';
|
|
end;
|
|
UpdateBtnStates;
|
|
end;
|
|
|
|
|
|
procedure TLifeTableForm.Compute;
|
|
var
|
|
varcols: IntDyneVec = nil;
|
|
i: integer;
|
|
AtRisk, ProbDie, CumProbLive, StdErr, Up95, Low95: double;
|
|
N, P, Q, mu, CI, z: double;
|
|
begin
|
|
CI := StrToFloat(CIEdit.Text);
|
|
z := InverseZ(CI);
|
|
|
|
SetLength(varcols, 5);
|
|
for i := 1 to 5 do
|
|
begin
|
|
if (OS3MainFrm.DataGrid.Cells[i,0] = ObsStartEdit.Text) then varcols[0] := i;
|
|
if (OS3MainFrm.DataGrid.Cells[i,0] = ObsEndEdit.Text) then varcols[1] := i;
|
|
if (OS3MainFrm.DataGrid.Cells[i,0] = NoAliveEdit.Text) then varcols[2] := i;
|
|
if (OS3MainFrm.DataGrid.Cells[i,0] = NoDiedEdit.Text) then varcols[3] := i;
|
|
if (OS3MainFrm.DataGrid.Cells[i,0] = NoCensoredEdit.Text) then varcols[4] := i;
|
|
end;
|
|
|
|
Grid.RowCount := NoCases + Grid.FixedRows;
|
|
for i := 1 to NoCases do
|
|
begin
|
|
Grid.Cells[0,i] := 'CASE ' + IntToStr(i);
|
|
Grid.Cells[1,i] := Trim(OS3MainFrm.DataGrid.Cells[varcols[0],i]);
|
|
Grid.Cells[2,i] := Trim(OS3MainFrm.DataGrid.Cells[varcols[1],i]);
|
|
Grid.Cells[3,i] := Trim(OS3MainFrm.DataGrid.Cells[varcols[2],i]);
|
|
Grid.Cells[4,i] := Trim(OS3MainFrm.DataGrid.Cells[varcols[3],i]);
|
|
Grid.Cells[5,i] := Trim(OS3MainFrm.DataGrid.Cells[varcols[4],i]);
|
|
end;
|
|
|
|
for i := 1 to NoCases do
|
|
begin
|
|
AtRisk := StrToFloat(Grid.Cells[3,i]);
|
|
AtRisk := AtRisk - (StrToFloat(Grid.Cells[5,i]) / 2.0);
|
|
Grid.Cells[6,i] := Format('%.4f', [AtRisk]);
|
|
ProbDie := StrToFloat(Grid.Cells[4,i]) / AtRisk;
|
|
Grid.Cells[7,i] := Format('%.4f', [ProbDie]);
|
|
Grid.Cells[8,i] := Format('%.4f', [1.0-ProbDie]);
|
|
end;
|
|
|
|
N := StrToFloat(Grid.Cells[3,1]);
|
|
Grid.Cells[9,1] := Grid.Cells[8,1];
|
|
|
|
P := StrToFloat(Grid.Cells[9,1]);
|
|
Q := 1.0 - P;
|
|
StdErr := sqrt(N * P * Q);
|
|
Grid.Cells[10,1] := Format('%.4f', [StdErr]);
|
|
|
|
mu := N * P;
|
|
Grid.Cells[10,1] := Format('%.4f', [StdErr]);
|
|
|
|
Up95 := mu + z * StdErr;
|
|
Low95 := mu - z * StdErr;
|
|
Grid.Cells[11,1] := Format('%.4f', [Low95]);
|
|
Grid.Cells[12,1] := Format('%.4f', [Up95]);
|
|
|
|
for i := 2 to NoCases do
|
|
begin
|
|
CumProbLive := StrToFloat(Grid.Cells[9,i-1]) * StrToFloat(Grid.Cells[8,i]);
|
|
Grid.Cells[9,i] := Format('%.4f', [CumProbLive]);
|
|
P := CumProbLive;
|
|
Q := 1.0 - P;
|
|
StdErr := sqrt(N * P * Q);
|
|
mu := N * P;
|
|
Grid.Cells[10,i] := Format('%.4f', [StdErr]);
|
|
Up95 := mu + z * StdErr;
|
|
Low95 := mu - z * StdErr;
|
|
Grid.Cells[11,i] := Format('%.4f', [Low95]);
|
|
Grid.Cells[12,i] := Format('%.4f', [Up95]);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TLifeTableForm.FormCreate(Sender: TObject);
|
|
begin
|
|
Assert(OS3MainFrm <> nil);
|
|
CIEdit.Text := FormatFloat('0.00', DEFAULT_CONFIDENCE_LEVEL_PERCENT * 0.01);
|
|
end;
|
|
|
|
|
|
procedure TLifeTableForm.GridPrepareCanvas(sender: TObject; aCol,
|
|
aRow: Integer; aState: TGridDrawState);
|
|
var
|
|
ts: TTextStyle;
|
|
begin
|
|
if aRow > 0 then begin
|
|
ts := Grid.Canvas.TextStyle;
|
|
ts.Alignment := taRightJustify;
|
|
Grid.Canvas.TextStyle := ts;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TLifeTableForm.NoCensoredInBtnClick(Sender: TObject);
|
|
var
|
|
index: integer;
|
|
begin
|
|
index := VarList.ItemIndex;
|
|
if (index > -1) and (NoCensoredEdit.Text = '') then
|
|
begin
|
|
NoCensoredEdit.Text := VarList.Items[index];
|
|
VarList.Items.Delete(index);
|
|
end;
|
|
UpdateBtnStates;
|
|
end;
|
|
|
|
|
|
procedure TLifeTableForm.NoCensoredOutBtnClick(Sender: TObject);
|
|
begin
|
|
if NoCensoredEdit.Text <> '' then
|
|
begin
|
|
VarList.Items.Add(NoCensoredEdit.Text);
|
|
NoCensoredEdit.Text := '';
|
|
end;
|
|
UpdateBtnStates;
|
|
end;
|
|
|
|
|
|
procedure TLifeTableForm.NoDiedInBtnClick(Sender: TObject);
|
|
var
|
|
index: integer;
|
|
begin
|
|
index := VarList.ItemIndex;
|
|
if (index > -1) and (NoDiedEdit.Text = '') then
|
|
begin
|
|
NoDiedEdit.Text := VarList.Items[index];
|
|
VarList.Items.Delete(index);
|
|
end;
|
|
UpdateBtnStates;
|
|
end;
|
|
|
|
|
|
procedure TLifeTableForm.NoDiedOutBtnClick(Sender: TObject);
|
|
begin
|
|
if NoDiedEdit.Text <> '' then
|
|
begin
|
|
VarList.Items.Add(NoDiedEdit.Text);
|
|
NoDiedEdit.Text := '';
|
|
end;
|
|
UpdateBtnStates;
|
|
end;
|
|
|
|
|
|
procedure TLifeTableForm.ObsEndInBtnClick(Sender: TObject);
|
|
var
|
|
index: integer;
|
|
begin
|
|
index := VarList.ItemIndex;
|
|
if (index > -1) and (OBsEndEdit.Text = '') then
|
|
begin
|
|
ObsEndEdit.Text := VarList.Items[index];
|
|
VarList.Items.Delete(index);
|
|
end;
|
|
UpdateBtnStates;
|
|
end;
|
|
|
|
procedure TLifeTableForm.ObsEndOutBtnClick(Sender: TObject);
|
|
begin
|
|
if ObsEndEdit.Text <> '' then
|
|
begin
|
|
VarList.Items.Add(ObsEndEdit.Text);
|
|
ObsEndEdit.Text := '';
|
|
end;
|
|
UpdateBtnStates;
|
|
end;
|
|
|
|
procedure TLifeTableForm.ObsStartInBtnClick(Sender: TObject);
|
|
var
|
|
index: integer;
|
|
begin
|
|
index := VarList.ItemIndex;
|
|
if (index > -1) and (ObsStartEdit.Text = '') then
|
|
begin
|
|
ObsStartEdit.Text := VarList.Items[index];
|
|
VarList.Items.Delete(index);
|
|
end;
|
|
UpdateBtnStates;
|
|
end;
|
|
|
|
procedure TLifeTableForm.ObsStartOutBtnClick(Sender: TObject);
|
|
begin
|
|
if ObsStartEdit.Text <> '' then
|
|
begin
|
|
VarList.Items.Add(ObsStartEdit.Text);
|
|
ObsStartEdit.Text := '';
|
|
end;
|
|
UpdateBtnStates;
|
|
end;
|
|
|
|
procedure TLifeTableForm.Reset;
|
|
var
|
|
i, j: integer;
|
|
begin
|
|
ObsStartEdit.Text := '';
|
|
ObsEndEdit.Text := '';
|
|
NoAliveEdit.Text := '';
|
|
NoDiedEdit.Text := '';
|
|
NoCensoredEdit.Text := '';
|
|
|
|
Grid.RowCount := 2; //NoCases + Grid.FixedRows;
|
|
Grid.ColCount := 13;
|
|
Grid.Cells[1,0] := 'Obs.Start';
|
|
Grid.Cells[2,0] := 'Obs.End';
|
|
Grid.Cells[3,0] := 'Alive';
|
|
Grid.Cells[4,0] := 'Died';
|
|
Grid.Cells[5,0] := 'Censored';
|
|
Grid.Cells[6,0] := 'At Risk';
|
|
Grid.Cells[7,0] := 'Prob.Die';
|
|
Grid.Cells[8,0] := 'Prob.Alive';
|
|
Grid.Cells[9,0] := 'Cum.P.Alive';
|
|
Grid.Cells[10,0] := 'S.E. Alive';
|
|
Grid.Cells[11,0] := 'Low 95%';
|
|
Grid.Cells[12,0] := 'Hi 95%';
|
|
for i := 0 to 12 do Grid.Cells[i, 1] := '';
|
|
// for j := 1 to NoCases do Grid.Cells[i,j] := '';
|
|
|
|
CollectVariableNames(OS3MainFrm.DataGrid, VarList.Items);
|
|
|
|
UpdateBtnStates;
|
|
end;
|
|
|
|
|
|
procedure TLifeTableForm.UpdateBtnStates;
|
|
begin
|
|
ObsStartInBtn.Enabled := (VarList.ItemIndex > -1) and (ObsStartEdit.Text = '');
|
|
ObsEndInBtn.Enabled := (VarList.ItemIndex > -1) and (ObsEndEdit.Text = '');
|
|
AliveInBtn.Enabled := (VarList.ItemIndex > -1) and (NoAliveEdit.Text = '');
|
|
NoDiedInBtn.Enabled := (VarList.itemIndex > -1) and (NoDiedEdit.Text = '');
|
|
NoCensoredInBtn.Enabled := (VarList.ItemIndex > -1) and (NoCensoredEdit.Text = '');
|
|
|
|
ObsStartOutBtn.Enabled := (ObsStartEdit.Text <> '');
|
|
ObsEndOutBtn.Enabled := (ObsEndEdit.Text > '');
|
|
AliveOutBtn.Enabled := (NoAliveEdit.Text <> '');
|
|
NoDiedOutBtn.Enabled := (NoDiedEdit.Text <> '');
|
|
NoCensoredOutBtn.Enabled := (NoCensoredEdit.Text > '');
|
|
end;
|
|
|
|
|
|
function TLifeTableForm.Validate(out AMsg: String; out AControl: TWinControl): Boolean;
|
|
begin
|
|
Result := false;
|
|
|
|
if ObsStartEdit.Text = '' then
|
|
begin
|
|
AMsg := 'Observation Start not specified.';
|
|
AControl := ObsStartEdit;
|
|
exit;
|
|
end;
|
|
|
|
if ObsEndEdit.Text = '' then
|
|
begin
|
|
AMsg := 'Observation End not specified.';
|
|
AControl := ObsEndEdit;
|
|
exit;
|
|
end;
|
|
|
|
if NoAliveEdit.Text = '' then
|
|
begin
|
|
AMsg := 'Number Alive not specified.';
|
|
AControl := NoAliveEdit;
|
|
exit;
|
|
end;
|
|
|
|
if NoDiedEdit.Text = '' then
|
|
begin
|
|
AMsg := 'Number Died not specified.';
|
|
AControl := NoDiedEdit;
|
|
exit;
|
|
end;
|
|
|
|
if NoCensoredEdit.Text = '' then
|
|
begin
|
|
AMsg := 'Number Censored not specified.';
|
|
AControl := NoCensoredEdit;
|
|
exit;
|
|
end;
|
|
|
|
Result := true;
|
|
end;
|
|
|
|
|
|
procedure TLifeTableForm.VarListDblClick(Sender: TObject);
|
|
var
|
|
index: Integer;
|
|
s: String;
|
|
begin
|
|
index := VarList.ItemIndex;
|
|
if index > -1 then
|
|
begin
|
|
s := VarList.Items[index];
|
|
if ObsStartEdit.Text = '' then
|
|
ObsStartEdit.Text := s
|
|
else if ObsEndEdit.Text = '' then
|
|
ObsEndEdit.Text := s
|
|
else if NoAliveEdit.Text = '' then
|
|
NoAliveEdit.Text := s
|
|
else if NoDiedEdit.Text = '' then
|
|
NoDiedEdit.Text := s
|
|
else if NoCensoredEdit.Text = '' then
|
|
NoCensoredEdit.Text := s
|
|
else
|
|
exit;
|
|
VarList.Items.Delete(index);
|
|
UpdateBtnStates;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TLifeTableForm.VarListSelectionChange(Sender: TObject; User: boolean);
|
|
begin
|
|
UpdateBtnStates;
|
|
end;
|
|
|
|
|
|
end.
|
|
|