73 lines
2.5 KiB
R
73 lines
2.5 KiB
R
options(na.action=na.exclude) # preserve missings
|
|
options(contrasts=c('contr.treatment', 'contr.poly')) #ensure constrast type
|
|
library(survival)
|
|
|
|
#
|
|
# Test out subscripting in the case of a coxph survival curve
|
|
#
|
|
aeq <- function(x,y, ...) all.equal(as.vector(x), as.vector(y), ...)
|
|
|
|
fit <- coxph(Surv(time, status) ~ age + sex + meal.cal + strata(ph.ecog),
|
|
data=lung)
|
|
surv1 <- survfit(fit)
|
|
temp <- surv1[2:3]
|
|
|
|
which <- cumsum(surv1$strata)
|
|
zed <- (which[1]+1):(which[3])
|
|
aeq(surv1$surv[zed], temp$surv)
|
|
aeq(surv1$time[zed], temp$time)
|
|
|
|
# This call should not create a model frame in the code -- so same
|
|
# answer but a different path through the underlying code
|
|
fit <- coxph(Surv(time, status) ~ age + sex + meal.cal + strata(ph.ecog),
|
|
x=T, data=lung)
|
|
surv2 <- survfit(fit)
|
|
all.equal(surv1, surv2)
|
|
|
|
#
|
|
# Now a result with a matrix of survival curves
|
|
#
|
|
dummy <- data.frame(age=c(30,40,60), sex=c(1,2,2), meal.cal=c(500, 1000, 1500))
|
|
surv2 <- survfit(fit, newdata=dummy)
|
|
|
|
zed <- 1:which[1]
|
|
aeq(surv2$surv[zed,1], surv2[1,1]$surv)
|
|
aeq(surv2$surv[zed,2], surv2[1,2]$surv)
|
|
aeq(surv2$surv[zed,3], surv2[1,3]$surv)
|
|
aeq(surv2$surv[zed, ], surv2[1,1:3]$surv)
|
|
aeq(surv2$surv[zed], (surv2[1])$surv)
|
|
aeq(surv2$surv[zed, ], surv2[1, ]$surv)
|
|
|
|
# And the depreciated form - call with a named vector as 'newdata'
|
|
# the resulting $call component won't match so delete it before comparing
|
|
# newdata will have mismatched row names due to subscripting
|
|
surv3 <- survfit(fit, c(age=40, sex=2, meal.cal=1000))
|
|
keep <- which(!(names(surv3) %in% c("newdata", "call")))
|
|
all.equal(unclass(surv2[,2])[keep], unclass(surv3)[keep])
|
|
|
|
# Test out offsets, which have recently become popular due to a Langholz paper
|
|
fit1 <- coxph(Surv(time, status) ~ age + ph.ecog, lung)
|
|
fit2 <- coxph(Surv(time, status) ~ age + offset(ph.ecog * fit1$coefficients[2]), lung)
|
|
|
|
surv1 <- survfit(fit1, newdata=data.frame(age=50, ph.ecog=1))
|
|
surv2 <- survfit(fit2, newdata=data.frame(age=50, ph.ecog=1))
|
|
all.equal(surv1$surv, surv2$surv)
|
|
|
|
# And a model with only offsets.
|
|
eta <- cbind(lung$age, lung$ph.ecog) %*% coef(fit1)
|
|
fit3 <- coxph(Surv(time, status) ~ offset(eta), lung)
|
|
aeq(fit3$loglik, fit1$loglik[2])
|
|
|
|
surv3 <- survfit(fit3, newdata=data.frame(eta= 50*fit1$coefficients[1] + fit1$coefficients[2]))
|
|
all.equal(surv3$surv, surv1$surv)
|
|
|
|
#
|
|
# Check out the start.time option
|
|
#
|
|
surv3 <- survfit(fit1, newdata=data.frame(age=50, ph.ecog=1),
|
|
start.time=100)
|
|
index <- match(surv3$time, surv1$time)
|
|
rescale <- summary(surv1, times=100)$surv
|
|
all.equal(surv3$surv, surv1$surv[index]/rescale)
|
|
|