diff --git a/applications/lazstats/data/coxreg.laz b/applications/lazstats/data/coxreg.laz new file mode 100644 index 000000000..e0b7db264 --- /dev/null +++ b/applications/lazstats/data/coxreg.laz @@ -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 diff --git a/applications/lazstats/docs/HelpNDoc/LazStats.hnd b/applications/lazstats/docs/HelpNDoc/LazStats.hnd index d6d41c22a..27cfe6652 100644 Binary files a/applications/lazstats/docs/HelpNDoc/LazStats.hnd and b/applications/lazstats/docs/HelpNDoc/LazStats.hnd differ diff --git a/applications/lazstats/docs/chm/LazStats.chm b/applications/lazstats/docs/chm/LazStats.chm index b2be3f389..1559bd7c0 100644 Binary files a/applications/lazstats/docs/chm/LazStats.chm and b/applications/lazstats/docs/chm/LazStats.chm differ diff --git a/applications/lazstats/source/forms/analysis/multiple_regression/coxregunit.lfm b/applications/lazstats/source/forms/analysis/multiple_regression/coxregunit.lfm index 053c77b48..45454d757 100644 --- a/applications/lazstats/source/forms/analysis/multiple_regression/coxregunit.lfm +++ b/applications/lazstats/source/forms/analysis/multiple_regression/coxregunit.lfm @@ -2,11 +2,11 @@ object CoxRegFrm: TCoxRegFrm Left = 457 Height = 401 Top = 291 - Width = 432 + Width = 424 AutoSize = True Caption = 'Cox Proportional Hazards Survival Regression' ClientHeight = 401 - ClientWidth = 432 + ClientWidth = 424 OnActivate = FormActivate OnCreate = FormCreate OnShow = FormShow @@ -27,7 +27,7 @@ object CoxRegFrm: TCoxRegFrm object Label2: TLabel AnchorSideLeft.Control = BlockList AnchorSideTop.Control = Owner - Left = 238 + Left = 234 Height = 15 Top = 8 Width = 116 @@ -38,7 +38,7 @@ object CoxRegFrm: TCoxRegFrm object Label3: TLabel AnchorSideLeft.Control = DepVar AnchorSideBottom.Control = DepVar - Left = 238 + Left = 234 Height = 15 Top = 108 Width = 114 @@ -50,7 +50,7 @@ object CoxRegFrm: TCoxRegFrm object Label4: TLabel AnchorSideLeft.Control = StatusEdit AnchorSideBottom.Control = StatusEdit - Left = 238 + Left = 234 Height = 15 Top = 195 Width = 120 @@ -64,11 +64,11 @@ object CoxRegFrm: TCoxRegFrm AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = GroupBox1 AnchorSideTop.Side = asrCenter - Left = 195 + Left = 219 Height = 15 Top = 296 Width = 117 - BorderSpacing.Left = 16 + BorderSpacing.Left = 40 Caption = 'Maximum Interations:' ParentColor = False end @@ -81,7 +81,7 @@ object CoxRegFrm: TCoxRegFrm Left = 8 Height = 221 Top = 26 - Width = 186 + Width = 182 Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Left = 8 BorderSpacing.Top = 2 @@ -90,13 +90,14 @@ object CoxRegFrm: TCoxRegFrm Constraints.MinHeight = 220 ItemHeight = 0 MultiSelect = True + OnSelectionChange = VarListSelectionChange TabOrder = 0 end object InBtn: TBitBtn AnchorSideLeft.Control = Owner AnchorSideLeft.Side = asrCenter AnchorSideTop.Control = VarList - Left = 202 + Left = 198 Height = 28 Top = 26 Width = 28 @@ -147,7 +148,7 @@ object CoxRegFrm: TCoxRegFrm AnchorSideLeft.Side = asrCenter AnchorSideTop.Control = InBtn AnchorSideTop.Side = asrBottom - Left = 202 + Left = 198 Height = 28 Top = 58 Width = 28 @@ -162,7 +163,7 @@ object CoxRegFrm: TCoxRegFrm AnchorSideLeft.Control = Owner AnchorSideLeft.Side = asrCenter AnchorSideTop.Control = Label3 - Left = 202 + Left = 198 Height = 28 Top = 108 Width = 28 @@ -177,7 +178,7 @@ object CoxRegFrm: TCoxRegFrm AnchorSideLeft.Side = asrCenter AnchorSideTop.Control = DepInBtn AnchorSideTop.Side = asrBottom - Left = 202 + Left = 198 Height = 28 Top = 140 Width = 28 @@ -192,7 +193,7 @@ object CoxRegFrm: TCoxRegFrm AnchorSideLeft.Control = Owner AnchorSideLeft.Side = asrCenter AnchorSideBottom.Control = StatusOutBtn - Left = 202 + Left = 198 Height = 28 Top = 187 Width = 28 @@ -210,7 +211,7 @@ object CoxRegFrm: TCoxRegFrm AnchorSideTop.Side = asrBottom AnchorSideBottom.Control = VarList AnchorSideBottom.Side = asrBottom - Left = 202 + Left = 198 Height = 28 Top = 219 Width = 28 @@ -229,16 +230,17 @@ object CoxRegFrm: TCoxRegFrm AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Label3 - Left = 238 + Left = 234 Height = 67 Top = 25 - Width = 186 + Width = 182 Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Left = 8 BorderSpacing.Top = 2 BorderSpacing.Right = 8 BorderSpacing.Bottom = 16 ItemHeight = 0 + OnSelectionChange = VarListSelectionChange TabOrder = 3 end object DepVar: TEdit @@ -248,13 +250,14 @@ object CoxRegFrm: TCoxRegFrm AnchorSideTop.Side = asrCenter AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom - Left = 238 + Left = 234 Height = 23 Top = 125 - Width = 186 + Width = 182 Anchors = [akTop, akLeft, akRight] BorderSpacing.Left = 8 BorderSpacing.Right = 8 + ReadOnly = True TabOrder = 6 Text = 'DepVar' end @@ -265,14 +268,15 @@ object CoxRegFrm: TCoxRegFrm AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = StatusOutBtn AnchorSideBottom.Side = asrBottom - Left = 238 + Left = 234 Height = 23 Top = 212 - Width = 186 + Width = 182 Anchors = [akLeft, akRight, akBottom] BorderSpacing.Left = 8 BorderSpacing.Right = 8 BorderSpacing.Bottom = 12 + ReadOnly = True TabOrder = 9 Text = 'StatusEdit' end @@ -323,97 +327,80 @@ object CoxRegFrm: TCoxRegFrm AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Label5 AnchorSideTop.Side = asrCenter - Left = 320 + Left = 344 Height = 23 Top = 292 Width = 42 Alignment = taRightJustify BorderSpacing.Left = 8 + BorderSpacing.Right = 8 TabOrder = 11 Text = 'MaxItsEdit' end object ResetBtn: TButton - AnchorSideRight.Control = CancelBtn + AnchorSideRight.Control = ComputeBtn AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom - Left = 111 + Left = 215 Height = 25 Top = 368 Width = 54 Anchors = [akRight, akBottom] AutoSize = True - BorderSpacing.Left = 32 + BorderSpacing.Left = 8 BorderSpacing.Top = 8 - BorderSpacing.Right = 12 + BorderSpacing.Right = 8 BorderSpacing.Bottom = 8 Caption = 'Reset' OnClick = ResetBtnClick TabOrder = 12 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 - AnchorSideRight.Control = ReturnBtn + AnchorSideRight.Control = CloseBtn AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom - Left = 251 + Left = 277 Height = 25 Top = 368 Width = 76 Anchors = [akRight, akBottom] AutoSize = True - BorderSpacing.Left = 12 + BorderSpacing.Left = 8 BorderSpacing.Top = 8 - BorderSpacing.Right = 12 + BorderSpacing.Right = 8 BorderSpacing.Bottom = 8 Caption = 'Compute' OnClick = ComputeBtnClick - TabOrder = 14 + TabOrder = 13 end - object ReturnBtn: TButton + object CloseBtn: TButton AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom - Left = 339 + Left = 361 Height = 25 Top = 368 - Width = 61 + Width = 55 Anchors = [akRight, akBottom] AutoSize = True - BorderSpacing.Left = 12 + BorderSpacing.Left = 8 BorderSpacing.Top = 8 - BorderSpacing.Right = 32 + BorderSpacing.Right = 8 BorderSpacing.Bottom = 8 - Caption = 'Return' - ModalResult = 1 - TabOrder = 15 + Caption = 'Close' + ModalResult = 11 + TabOrder = 14 end object Bevel1: TBevel AnchorSideLeft.Control = Owner AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom - AnchorSideBottom.Control = ReturnBtn + AnchorSideBottom.Control = CloseBtn Left = 0 Height = 8 Top = 352 - Width = 432 + Width = 424 Anchors = [akLeft, akRight, akBottom] Shape = bsBottomLine end diff --git a/applications/lazstats/source/forms/analysis/multiple_regression/coxregunit.pas b/applications/lazstats/source/forms/analysis/multiple_regression/coxregunit.pas index 33d2d9a9d..9262b5ce2 100644 --- a/applications/lazstats/source/forms/analysis/multiple_regression/coxregunit.pas +++ b/applications/lazstats/source/forms/analysis/multiple_regression/coxregunit.pas @@ -23,9 +23,8 @@ type StatusInBtn: TBitBtn; StatusOutBtn: TBitBtn; ResetBtn: TButton; - CancelBtn: TButton; ComputeBtn: TButton; - ReturnBtn: TButton; + CloseBtn: TButton; DescChk: TCheckBox; MaxItsEdit: TEdit; Label5: TLabel; @@ -54,10 +53,12 @@ type function ChiSq(x : double; n : integer) : double; function Norm(z : double): double; function ix(j, k, nCols : integer): integer; + procedure VarListSelectionChange(Sender: TObject; User: boolean); private { private declarations } FAutoSized: Boolean; + procedure UpdateBtnStates; public { public declarations } end; @@ -73,42 +74,41 @@ uses { TCoxRegFrm } procedure TCoxRegFrm.ResetBtnClick(Sender: TObject); -VAR i : integer; +var + i: integer; begin - BlockList.Clear; - VarList.Clear; - for i := 1 to NoVariables do - begin - VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); - end; - InBtn.Enabled := true; - OutBtn.Enabled := false; - DepInBtn.Enabled := true; - DepOutBtn.Enabled := false; - ProbsChk.Checked := true; - DescChk.Checked := true; - DepVar.Text := ''; - StatusEdit.Text := ''; - StatusInBtn.Enabled := true; - StatusOutBtn.Enabled := false; - MaxItsEdit.Text := '20'; + BlockList.Clear; + VarList.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + ProbsChk.Checked := true; + DescChk.Checked := true; + DepVar.Text := ''; + StatusEdit.Text := ''; + MaxItsEdit.Text := '20'; end; procedure TCoxRegFrm.StatusInBtnClick(Sender: TObject); -VAR index : integer; +var + index: integer; begin - index := VarList.ItemIndex; - StatusEdit.Text := VarList.Items.Strings[index]; - VarList.Items.Delete(index); - StatusOutBtn.Enabled := true; - StatusInBtn.Enabled := false; + index := VarList.ItemIndex; + if (index > -1) and (StatusEdit.Text = '') then + begin + StatusEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; end; procedure TCoxRegFrm.StatusOutBtnClick(Sender: TObject); begin - VarList.Items.Add(StatusEdit.Text); - StatusEdit.Text := ''; - StatusInBtn.Enabled := true; + if (StatusEdit.Text <> '') then + begin + VarList.Items.Add(StatusEdit.Text); + StatusEdit.Text := ''; + end; + UpdateBtnStates; end; procedure TCoxRegFrm.FormActivate(Sender: TObject); @@ -118,11 +118,10 @@ begin if FAutoSized then exit; - w := MaxValue([ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); ResetBtn.Constraints.MinWidth := w; - CancelBtn.Constraints.MinWidth := w; ComputeBtn.Constraints.MinWidth := w; - ReturnBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; Constraints.MinWidth := Width; Constraints.MinHeight := Height; @@ -133,7 +132,6 @@ end; procedure TCoxRegFrm.FormCreate(Sender: TObject); begin Assert(OS3MainFrm <> nil); - if OutputFrm = nil then Application.CreateForm(TOutputFrm, OutputFrm); end; procedure TCoxRegFrm.FormShow(Sender: TObject); @@ -142,17 +140,29 @@ begin end; procedure TCoxRegFrm.DepInBtnClick(Sender: TObject); -VAR index : integer; +var + index: integer; begin - index := VarList.ItemIndex; - DepVar.Text := VarList.Items.Strings[index]; - VarList.Items.Delete(index); - DepOutBtn.Enabled := true; - DepInBtn.Enabled := false; + index := VarList.ItemIndex; + if (index > -1) and (DepVar.Text = '') then + begin + DepVar.Text := VarList.Items[index]; + 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; procedure TCoxRegFrm.ComputeBtnClick(Sender: TObject); -Label CleanUp; var i, j, k : integer; indx : integer; @@ -192,409 +202,461 @@ var Hi95 : double; d : double; iters : integer; + lReport: TStrings; begin - OutputFrm.RichEdit.Clear; -// OutputFrm.RichEdit.ParaGraph.Alignment := taLeftJustify; - OutputFrm.RichEdit.Lines.Add('Cox Proportional Hazards Survival Regression Adapted from John C. Pezzullo'); - OutputFrm.RichEdit.Lines.Add('Java program at http://members.aol.com/johnp71/prophaz.html'); + if MaxItsEdit.Text = '' then + begin + MaxItsEdit.Setfocus; + MessageDlg('Maximum iterations not specified.', mtError, [mbOK], 0); + exit; + end; - { get independent item columns } - nR := BlockList.Items.Count; - nC := NoCases; - SetLength(ColNoSelected,nR + 2); - SetLength(RowLabels,nR + 2); - SetLength(ColLabels,nR + 2); - if nR < 1 then - begin - ShowMessage('ERROR! No independent variables selected.'); - goto CleanUp; - end; + if not TryStrToInt(MaxItsEdit.Text, iters) then + begin + MaxItsEdit.SetFocus; + MessageDlg('Valid number required.', mtError, [mbOK], 0); + exit; + end; - for i := 1 to nR do - begin - cellstring := BlockList.Items.Strings[i-1]; - for j := 1 to NoVariables do - begin - if cellstring = OS3MainFrm.DataGrid.Cells[j,0] then - begin - ColNoSelected[i-1] := j; - RowLabels[i-1] := cellstring; - ColLabels[i-1] := cellstring; - end; - end; - end; + { get independent item columns } + nR := BlockList.Items.Count; + nC := NoCases; + SetLength(ColNoSelected,nR + 2); + SetLength(RowLabels,nR + 2); + SetLength(ColLabels,nR + 2); + if nR < 1 then + begin + MessageDlg('No independent variables selected.', mtError, [mbOK], 0); + exit; + end; - { get survival time variable column and survival status var. column } - if DepVar.Text = '' then - begin - 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 i := 1 to nR do + begin + cellstring := BlockList.Items.Strings[i-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; + if cellstring = OS3MainFrm.DataGrid.Cells[j,0] then + begin + ColNoSelected[i-1] := j; + RowLabels[i-1] := cellstring; + ColLabels[i-1] := cellstring; + end; end; + end; - SetLength(SurvT,nC + 1); - SetLength(Stat,nC + 1); - SetLength(Dupl,nC + 1); - SetLength(Alpha,nC + 1); - SetLength(x,(nC + 1) * (nR + 1)); - SetLength(b,nC + 1); - SetLength(a,(nR + 1) * (nR + 1)); - SetLength(s1,nR + 1); - SetLength(s2,(nR + 1) * (nR + 1)); - SetLength(s,nR + 1); - SetLength(Av,nR + 1); - SetLength(SD,nR + 1); - SetLength(SE,nR + 1); + { get survival time variable column and survival status var. column } + if DepVar.Text = '' then + begin + MessageDlg('No Survival time variable selected.', mtError, [mbOK], 0); + exit; + end; + if StatusEdit.Text = '' then + begin + MessageDlg('No Survival Status variable selected.', mtError, [mbOK], 0); + exit; + end; + nP := 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 - for i := 0 to nC - 1 do - begin - indx := ix(i,0,nR+1); - X[indx] := 1; - for j := 0 to nR-1 do - begin - indx := ColNoSelected[j]; - zX := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[indx,i+1])); - indx := ix(i,j,nR); - x[indx] := zX; - Av[j] := Av[j] + zX; - SD[j] := SD[j] + (zX * zX); - 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 + SetLength(SurvT,nC + 1); + SetLength(Stat,nC + 1); + SetLength(Dupl,nC + 1); + SetLength(Alpha,nC + 1); + SetLength(x,(nC + 1) * (nR + 1)); + SetLength(b,nC + 1); + SetLength(a,(nR + 1) * (nR + 1)); + SetLength(s1,nR + 1); + SetLength(s2,(nR + 1) * (nR + 1)); + SetLength(s,nR + 1); + SetLength(Av,nR + 1); + SetLength(SD,nR + 1); + SetLength(SE,nR + 1); - // print descriptive statistics - OutputFrm.RichEdit.Lines.Add(''); - if DescChk.Checked then - begin - OutputFrm.RichEdit.Lines.Add('Descriptive Statistics'); - OutputFrm.RichEdit.Lines.Add('Variable Label Average Std.Dev.'); - end; - for j := 0 to nR-1 do - begin - Av[j] := Av[j] / nC; - SD[j] := SD[j] / nC; - SD[j] := sqrt( abs(SD[j] - Av[j] * Av[j])); - if DescChk.Checked then - begin - outline := format(' %3d %15s %10.4f %10.4f',[j+1,RowLabels[j],Av[j],SD[j]]); - OutputFrm.RichEdit.Lines.Add(outline); - end; - end; - OutputFrm.RichEdit.Lines.Add(''); + // get data + for i := 0 to nC - 1 do + begin + indx := ix(i,0,nR+1); + X[indx] := 1; + for j := 0 to nR-1 do + begin + indx := ColNoSelected[j]; + zX := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[indx,i+1])); + indx := ix(i,j,nR); + x[indx] := zX; + Av[j] := Av[j] + zX; + SD[j] := SD[j] + (zX * zX); + 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 - d := 0.0; - Eps := 1.0 / 1024.0; - for i := 0 to nC-2 do - begin - iBig := i; - for j := i+1 to nC-1 do - 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; + // print descriptive statistics + lReport := TStringList.Create; + try + lReport.Add('COX PROPORTIONAL HARARDS SURVIVAL REGRESSION adapted from John C. Pezzullo'); + lReport.Add('Java program at http://members.aol.com/johnp71/prophaz.html'); + lReport.Add(''); - if Stat[0] > 0 then Stat[0] := Stat[0] + 2; - for i := 1 to nC-1 do - begin - if (Stat[i] > 0) and ((Stat[i-1] = 0) or (SurvT[i-1] <> SurvT[i])) then - Stat[i] := Stat[i] + 2; - end; - if Stat[nC-1] > 0 then Stat[nC-1] := Stat[nC-1] + 4; - for i := nC-2 downto 0 do - begin - if (Stat[i] > 0) and ((Stat[i+1] = 0) or (SurvT[i+1] <> Survt[i])) then - Stat[i] := Stat[i] + 4; - 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 OutputFrm.RichEdit.Lines.Add('Iteration History...'); - for j := 0 to nR-1 do b[j] := 0; - LLp := 2.0e30; - LL := 1.0e30; + if DescChk.Checked then + begin + lReport.Add('Descriptive Statistics'); + lReport.Add('Variable Label Average Std.Dev.'); + end; + for j := 0 to nR-1 do + begin + Av[j] := Av[j] / nC; + SD[j] := SD[j] / nC; + SD[j] := sqrt( abs(SD[j] - Av[j] * Av[j])); + if DescChk.Checked then + lReport.Add(' %3d %15s %11.4f %11.4f', [j+1, RowLabels[j], Av[j], SD[j]]); + end; + lReport.Add(''); - // 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 = %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; + d := 0.0; + Eps := 1.0 / 1024.0; + for i := 0 to nC-2 do + begin + iBig := i; + for j := i+1 to nC-1 do + if (SurvT[j] - Eps * Stat[j]) > (SurvT[iBig]-Eps * Stat[iBig]) then + iBig := j; + 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; - OutputFrm.RichEdit.Lines.Add('Converged'); - Csq := LLn - LL; - 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; + if Stat[0] > 0 then + Stat[0] := Stat[0] + 2; -cleanup: - 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; + for i := 1 to nC-1 do + begin + if (Stat[i] > 0) and ((Stat[i-1] = 0) or (SurvT[i-1] <> SurvT[i])) then + Stat[i] := Stat[i] + 2; + end; + if Stat[nC-1] > 0 then + Stat[nC-1] := Stat[nC-1] + 4; -procedure TCoxRegFrm.DepOutBtnClick(Sender: TObject); -begin - VarList.Items.Add(DepVar.Text); - DepVar.Text := ''; - DepInBtn.Enabled := true; + for i := nC-2 downto 0 do + begin + if (Stat[i] > 0) and ((Stat[i+1] = 0) or (SurvT[i+1] <> Survt[i])) then + Stat[i] := Stat[i] + 4; + 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; procedure TCoxRegFrm.InBtnClick(Sender: TObject); -VAR i, index : integer; +var + i: integer; begin - index := VarList.Items.Count; - i := 0; - while i < index do - begin - if (VarList.Selected[i]) then - begin - BlockList.Items.Add(VarList.Items.Strings[i]); - VarList.Items.Delete(i); - index := index - 1; - i := 0; - end - else i := i + 1; - end; - OutBtn.Enabled := true; + i := 0; + while i < VarList.Items.Count do + begin + if VarList.Selected[i] then + begin + BlockList.Items.Add(VarList.Items[i]); + VarList.Items.Delete(i); + i := 0; + end else + i := i + 1; + end; + UpdateBtnStates; end; 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 - p, t, a : double; - k : integer; - + i: integer; begin - 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; - ChiSq := (1 - p); + i := 0; + while i < BlockList.Items.Count do + begin + if BlockList.Selected[i] then + begin + VarList.Items.Add(BlockList.Items[i]); + BlockList.Items.Delete(i); + i := 0; + end else + i := i + 1; + end; + UpdateBtnStates; end; -//------------------------------------------------------------------- -function TCoxRegFrm.Norm(z : double): double; +function TCoxRegFrm.ChiSq(x: double; n: integer): double; +var + p, t, a: double; + k: integer; 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; //------------------------------------------------------------------- function TCoxRegFrm.ix(j, k, nCols : integer): integer; begin - ix := j * nCols + k; + Result := j*nCols + k; 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 {$I coxregunit.lrs}