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, ovariandeviance = function(object) -2*as.numeric(logLik(object))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 |
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))coxph(Surv(time,status)~1,collett::liverbase) |> deviance()[1] 25.12133coxph(Surv(time,status)~age,collett::liverbase) |> deviance()[1] 22.13537coxph(Surv(time,status)~lbr,collett::liverbase) |> deviance()[1] 21.66235(fit2 <- coxph(Surv(time,status)~age+lbr,collett::liverbase)) |> deviance()[1] 18.47542treat:(fit3 <- coxph(Surv(time,status)~age+lbr+treat,collett::liverbase)) |> deviance()[1] 13.29283summary(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.02anova(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 ' ' 1coxph(Surv(tstart,tstop,status)~1,liver) |> deviance()[1] 25.12133coxph(Surv(tstart,tstop,status)~age,liver) |> deviance()[1] 22.13537coxph(Surv(tstart,tstop,status)~lbr,liver) |> deviance()[1] 12.04975(fit2 <- coxph(Surv(tstart,tstop,status)~age+lbr,liver)) |> deviance()[1] 11.14492treat(fit3 <- coxph(Surv(tstart,tstop,status)~lbr+treat,liver)) |> deviance()[1] 10.6762summary(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.001sfit3 = 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-06sfit3 = 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"))
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-79table_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.4578058It 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