library(survival) # # Tests with the pspline function, to verify the prediction aspects # options(na.action=na.exclude) aeq <- function(x,y, ...) all.equal(as.vector(x), as.vector(y), ...) spfit <- coxph(Surv(time, status) ~ pspline(age) + ph.ecog, lung) spfit2 <- coxph(Surv(time, status) ~ pspline(age) + ph.ecog, lung, x=TRUE) x2 <- model.matrix(spfit) all.equal(spfit2$x, x2) keep <- (lung$age < 60) x3 <- model.matrix(spfit, data=lung[keep,]) attr(x3, 'assign') <- NULL #subscripting loses the assign attr below all.equal(napredict(spfit$na.action,x2)[keep,], x3) p2 <- predict(spfit, newdata=lung[keep,]) aeq(p2, predict(spfit)[keep]) p3 <- survfit(spfit) p4 <- survfit(spfit, newdata=lung[1:2,]) temp <- scale(x2[1:2,], center=spfit$means, scale=FALSE)%*% coef(spfit) aeq(p3$time, p4$time) aeq(outer(-log(p3$surv), exp(temp), '*'), -log(p4$surv)) # Check out model.frame spfit3 <- coxph(Surv(time, status) ~ pspline(age) + sex, lung, model=TRUE) #avoid the missing value m2 <- model.frame(spfit3, data=lung[keep,]) all.equal(m2, spfit3$model[keep,], check.attributes=FALSE) # # Test of residuals, in response to a reported bug. # These are three progam paths that should all lead to the same C routine fit <- coxph(Surv(tstart, tstop, status) ~ sex + treat + pspline(age), cgd) fit2 <- coxph(Surv(tstart, tstop, status) ~ fit$linear, cgd, iter=0, init=1) fit3 <- coxph(Surv(tstart, tstop, status) ~ offset(fit$linear), cgd) all.equal(fit$resid, fit2$resid) all.equal(fit$resid, fit3$resid) # # Check using coxph.detail. The matrix multiply below only is # valid for the breslow approximation. fit4 <- coxph(Surv(tstart, tstop, status) ~ sex + treat + pspline(age), cgd, ties='breslow') dt <- coxph.detail(fit4, riskmat=TRUE) # the results of coxph.detail used to be in time order, now are in data set # order rscore <- exp(fit4$linear) exp4 <- (rscore *dt$riskmat) %*% dt$hazard r4 <- cgd$status - exp4 aeq(r4, fit4$resid)