Survival Analysis in Medical Research
Author: Code by Mark Clements

# Example 8.4: Data from a cirrhosis study

- We use the following three libraries:

    library(knitr) # kable
    library(collett) # lbrdata0, liverbase
    library(survival) # coxph

    Attaching package: 'survival'

    The following objects are masked from 'package:collett':

        bladder, kidney, lung, myeloma, ovarian

    deviance = function(object) -2*as.numeric(logLik(object))

- The following data were used in the analysis; see Tables 8.4 and 8.5 in Collett (2023).

    kable(collett::liverbase, "html")

patient | time | status | age | treat | lbr
--- | --- | --- | --- | --- | ---
1 | 281 | 1 | 46 | 0 | 3.2
2 | 604 | 0 | 57 | 0 | 3.1
3 | 457 | 1 | 56 | 0 | 2.2
4 | 384 | 1 | 65 | 0 | 3.9
5 | 341 | 0 | 73 | 0 | 2.8
6 | 842 | 1 | 64 | 0 | 2.4
7 | 1514 | 1 | 69 | 1 | 2.4
8 | 182 | 0 | 62 | 1 | 2.4
9 | 1121 | 1 | 71 | 1 | 2.5
10 | 1411 | 0 | 69 | 1 | 2.3
11 | 814 | 1 | 77 | 1 | 3.8
12 | 1071 | 1 | 58 | 1 | 3.1

    kable(collett::lbrdata0, "html")

patient | time | lbr
--- | --- | ---
1 | 47 | 3.8
1 | 184 | 4.9
1 | 251 | 5.0
2 | 94 | 2.9
2 | 187 | 3.1
2 | 321 | 3.2
3 | 61 | 2.8
3 | 97 | 2.9
3 | 142 | 3.2
3 | 359 | 3.4
3 | 440 | 3.8
4 | 92 | 4.7
4 | 194 | 4.9
4 | 372 | 5.4
5 | 87 | 2.6
5 | 192 | 2.9
5 | 341 | 3.4
6 | 94 | 2.3
6 | 197 | 2.8
6 | 384 | 3.5
6 | 795 | 3.9
7 | 74 | 2.9
7 | 202 | 3.0
7 | 346 | 3.0
7 | 917 | 3.9
7 | 1411 | 5.1
8 | 90 | 2.5
8 | 182 | 2.9
9 | 101 | 2.5
9 | 410 | 2.7
9 | 774 | 2.8
9 | 1043 | 3.4
10 | 182 | 2.2
10 | 847 | 2.8
10 | 1051 | 3.3
10 | 1347 | 4.9
11 | 167 | 3.9
11 | 498 | 4.3
12 | 108 | 2.8
12 | 187 | 3.4
12 | 362 | 3.9
12 | 694 | 3.8

- We can merge the data together using the `survival::tmerge` function. The trick here is to first `tmerge` the baseline `collett::liverbase` dataset with itself and then merge in the exposure data:

    temp = transform(collett::liverbase, lbr=NULL)
    liver = tmerge(temp, temp, id=patient, status=event(time,status)) |>
        tmerge(rbind(with(collett::liverbase, data.frame(patient,tstart=0,lbr)),
                     with(collett::lbrdata0, data.frame(patient,tstart=time,lbr))),
               id=patient, lbr = tdc(tstart,lbr))

- Table 8.6:

    coxph(Surv(time,status)~1,collett::liverbase) |> deviance()

    [1] 25.12133

    coxph(Surv(time,status)~age,collett::liverbase) |> deviance()

    [1] 22.13537

    coxph(Surv(time,status)~lbr,collett::liverbase) |> deviance()

    [1] 21.66235

    (fit2 <- coxph(Surv(time,status)~age+lbr,collett::liverbase)) |> deviance()

    [1] 18.47542

- Inclusion of `treat`:

    (fit3 <- coxph(Surv(time,status)~age+lbr+treat,collett::liverbase)) |> deviance()

    [1] 13.29283

    summary(fit3)

    Call:
    coxph(formula = Surv(time, status) ~ age + lbr + treat, data = collett::liverbase)

      n= 12, number of events= 8

              coef exp(coef) se(coef)      z Pr(>|z|)
    age   -0.08503   0.91848  0.07728 -1.100   0.2712
    lbr    2.56080  12.94622  1.27211  2.013   0.0441 *
    treat -3.05192   0.04727  1.56150 -1.954   0.0506 .
    ---
    Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

          exp(coef) exp(-coef) lower .95 upper .95
    age     0.91848    1.08875  0.789394     1.069
    lbr    12.94622    0.07724  1.069837   156.664
    treat   0.04727   21.15586  0.002215     1.009

    Concordance= 0.923  (se = 0.04 )
    Likelihood ratio test= 11.83  on 3 df,   p=0.008
    Wald test            = 5.43  on 3 df,   p=0.1
    Score (logrank) test = 10.26  on 3 df,   p=0.02

    anova(fit2,fit3)

    Analysis of Deviance Table
     Cox model: response is  Surv(time, status)
     Model 1: ~ age + lbr
     Model 2: ~ age + lbr + treat
       loglik  Chisq Df Pr(>|Chi|)
    1 -9.2377
    2 -6.6464 5.1826  1    0.02281 *
    ---
    Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

- Analysis of log(bilirubin) as a time-varying exposure

    coxph(Surv(tstart,tstop,status)~1,liver) |> deviance()

    [1] 25.12133

    coxph(Surv(tstart,tstop,status)~age,liver) |> deviance()

    [1] 22.13537

    coxph(Surv(tstart,tstop,status)~lbr,liver) |> deviance()

    [1] 12.04975

    (fit2 <- coxph(Surv(tstart,tstop,status)~age+lbr,liver)) |> deviance()

    [1] 11.14492

- Inclusion of `treat`

    (fit3 <- coxph(Surv(tstart,tstop,status)~lbr+treat,liver)) |> deviance()

    [1] 10.6762

    summary(fit3)

    Call:
    coxph(formula = Surv(tstart, tstop, status) ~ lbr + treat, data = liver)

      n= 52, number of events= 8

             coef exp(coef) se(coef)      z Pr(>|z|)
    lbr    3.6048   36.7731   2.2449  1.606    0.108
    treat -1.4791    0.2278   1.3403 -1.104    0.270

          exp(coef) exp(-coef) lower .95 upper .95
    lbr     36.7731    0.02719   0.45151  2995.004
    treat    0.2278    4.38912   0.01647     3.151

    Concordance= 0.923  (se = 0.067 )
    Likelihood ratio test= 14.45  on 2 df,   p=7e-04
    Wald test            = 3.09  on 2 df,   p=0.2
    Score (logrank) test = 13.23  on 2 df,   p=0.001

- Cumulative hazard (Table 8.8):

    sfit3 = survfit(fit3,newdata=data.frame(treat=0,lbr=0))
    with(summary(sfit3), data.frame(time,H0=-log(surv)))

      time           H0
    1  281 8.716865e-09
    2  384 1.222210e-08
    3  457 5.413506e-07
    4  814 9.084826e-07
    5  842 1.577272e-06
    6 1071 3.318074e-06
    7 1121 6.007338e-06
    8 1514 6.052855e-06

- Figure 8.5

    sfit3 = survfit(fit3,newdata=data.frame(treat=0:1,lbr=3))
    plot(sfit3, col=c("black","grey"), lwd=2, xlab="Survival time (days)",
         ylab="Estimated survival function")
    legend("bottomleft",c("Placebo","Liverol"), lwd=2, col=c("black","grey"))

## Predicted survival for time-varying exposures

- For Table 8.9, the author proposes an estimand based on a constant exposure for the exposure that immediately precedes the start time:

    table_8.9 = function(object,data,times) {
        ## find the tstart that immediately precedes the specified times
        newdata = data[findInterval(head(times,-1),data$tstart),] |>
            ## set up the start and stop times and initialise the surv variable
            transform(tstart=head(times,-1),
                      tstop=times[-1],
                      surv=NA)
        ## the following could be vectorised -- but the for-loop may be easier to read
        for (i in 1:nrow(newdata)) {
            row = newdata[i,]
            ## predict survival for that row
            summ = summary(survfit(object, newdata=row, start.time=row$tstart),
                           times=row$tstop)
            newdata$surv[i] = summ$surv
        }
        newdata
    }
    table_8.9(fit3, subset(liver, patient==1), times = seq(0,360*4,by=360))

        patient time status age treat tstart tstop lbr         surv
    1         1  281      0  46     0      0   360 3.2 9.991090e-01
    4         1  281      1  46     0    360   720 5.0 2.787572e-16
    4.1       1  281      1  46     0    720  1080 5.0 8.127442e-82
    4.2       1  281      1  46     0   1080  1440 5.0 2.911149e-79

    table_8.9(fit3, subset(liver, patient==7), times = seq(0,360*4,by=360))

         patient time status age treat tstart tstop lbr      surv
    27         7 1514      0  69     1      0   360 2.4 0.9999886
    30         7 1514      0  69     1    360   720 3.0 0.9939837
    30.1       7 1514      0  69     1    720  1080 3.0 0.9690306
    31         7 1514      0  69     1   1080  1440 3.9 0.4578058

### Extension

- It may be more elegant to allow for

- We have written: (a) a function `collett::predict_coxph_tv` to predict survival for subjects with different time-varying exposures; and (b) used that function to predict interval-specific survival for specified times (`predict_coxph_tv_cond`; see below).

- As a reminder, for a time-varying exposure xi(t) for subject i and time t, we have that Si(t) = exp (−∫0texp (xi(u)Tβ)dΛ0(u)), where Λ0(u) is the estimated baseline cumulative hazard. Note that the integration is essentially a sum.

    #' @param object a coxph object
    #' @param data a data-frame or tmerge object with columns tstart, tstop, status, an id and the exposure variables
    #' @param id a character for the subject id
    #' @param times a numeric vector of times (a zero will be added to the start if not included)
    #' @returns a data-frame with cumulative and interval-specific survival probabilities
    predict_coxph_tv_cond = function(object,data,id,times) {
        stopifnot(inherits(object,"coxph"),
                  inherits(data,"data.frame"),
                  all(c("tstart","tstop","status",id) %in% names(data)),
                  is.numeric(times))
        if (times[1] != 0) times = c(0,times)
        data2 = by(data, data[[id]], function(datai)
            ## append for the later times
            if (max(datai$tstop)>max(times))
                datai else rbind(datai,
                                transform(datai[nrow(datai),],
                                          tstart=tstop,tstop=max(times),status=0))) |>
            do.call(what=rbind) |>
            ## and split the times
            survSplit(Surv(tstart,tstop,status)~., data=_, cut=times)
        data3 = predict_coxph_tv(object, data2, id)
        by(data3, data3[[id]], function(datai) {
            ## survival and cumulative hazards at the required times
            surv = subset(datai, tstop %in% times)$surv
            H = c(0,-log(surv)) # padded with H(0)=0
            ## interval-specific survival for required times
            newdata2 = data.frame(id=datai[[id]][1],
                                  tstart=head(times,-1),
                                  tstop=times[-1],
                                  surv,
                                  P=exp(-diff(H)))
            names(newdata2)[1] = id
            newdata2
        }) |> do.call(what=rbind)
    }
    ## Table 8.9
    predict_coxph_tv_cond(fit3,data=subset(liver,patient %in% c(1,7)),
                          id="patient",times=seq(0,360*4,by=360))

        patient tstart tstop          surv            P
    1.1       1      0   360  5.564639e-01 5.564639e-01
    1.2       1    360   720  1.551183e-16 2.787572e-16
    1.3       1    720  1080  1.260715e-97 8.127442e-82
    1.4       1   1080  1440 3.670129e-176 2.911149e-79
    7.1       7      0   360  9.999012e-01 9.999012e-01
    7.2       7    360   720  9.938855e-01 9.939837e-01
    7.3       7    720  1080  5.923699e-01 5.960142e-01
    7.4       7   1080  1440  2.711904e-01 4.578058e-01