The hardware and bandwidth for this mirror is donated by dogado GmbH, the Webhosting and Full Service-Cloud Provider. Check out our Wordpress Tutorial.
If you wish to report a bug, or if you are interested in having us mirror your free-software or open-source project, please feel free to contact us at mirror[@]dogado.de.
coxdev computes the deviance of the Cox proportional
hazards model, its gradient and the diagonal of its Hessian with respect
to the linear predictor, the information as a matrix-free operator, the
score residuals, the baseline hazard, and draws of the score. This
vignette fits a model by Newton’s method, computes robust standard
errors and survival curves, and shows what keeping the sorted data in a
CoxDeviance object saves. Sampling the score has its own
vignette, vignette("sampling", package = "coxdev"). The
Python package has the same two, as the notebooks
doc/using_coxdev.md and doc/sampling.md.
library(coxdev)
library(survival)Survival times on a coarse grid, so that there are many ties, with delayed entry and censoring.
set.seed(1)
n <- 500
p <- 3
X <- matrix(rnorm(n * p), n, p, dimnames = list(NULL, c("x1", "x2", "x3")))
beta <- c(0.5, -0.5, 0.25)
time <- rexp(n, exp(drop(X %*% beta)))
cens <- rexp(n, 0.5)
stop <- ceiling(pmin(time, cens) * 4) / 4
status <- as.integer(time <= cens)
start <- floor(runif(n, 0, 0.5) * stop * 8) / 8
y <- Surv(start, stop, status)
cox <- CoxDeviance$new(y, tie_breaking = "efron")
cox
#> <CoxDeviance> 500 observations, 344 failures, efron ties, with start timesThe response can also be given as vectors, as in the Python package:
CoxDeviance$new(event = stop, status = status, start = start).
compute() returns the deviance and its derivatives with
respect to the linear predictor eta.
information() returns the information (half the Hessian of
the deviance) as an n by n operator. It is
never formed: a product with it costs about as much as a gradient. For a
design X, crossprod(X, I %*% X) is the
information of the coefficients, so Newton’s method takes a few
lines.
b <- rep(0, p)
for (iter in 1:10) {
eta <- drop(X %*% b)
res <- cox$compute(eta)
score <- -drop(crossprod(X, res$gradient)) / 2
info <- crossprod(X, cox$information(eta) %*% X)
step <- solve(info, score)
b <- b + step
if (max(abs(step)) < 1e-10) break
}
iter
#> [1] 4
b
#> x1 x2 x3
#> 0.4530326 -0.3534272 0.3209856These are the estimates of coxph from
survival, with the same standard errors:
fit <- coxph(y ~ X, ties = "efron")
rbind(coxdev = b, coxph = coef(fit))
#> x1 x2 x3
#> coxdev 0.4530326 -0.3534272 0.3209856
#> coxph 0.4530326 -0.3534272 0.3209856
rbind(coxdev = sqrt(diag(solve(info))), coxph = sqrt(diag(vcov(fit))))
#> x1 x2 x3
#> coxdev 0.05728271 0.05369269 0.05491812
#> coxph 0.05728271 0.05369269 0.05491812The score residuals of the design give the robust (sandwich)
variance, solve(I) %*% crossprod(U) %*% solve(I):
eta_hat <- drop(X %*% b)
U <- cox$score_residuals(eta_hat, X)
info_hat <- crossprod(X, cox$information(eta_hat) %*% X)
robust <- solve(info_hat, t(solve(info_hat, crossprod(U))))
fit_robust <- coxph(y ~ X, ties = "efron", id = seq_len(n), robust = TRUE)
rbind(coxdev = sqrt(diag(robust)), coxph = sqrt(diag(vcov(fit_robust))))
#> x1 x2 x3
#> coxdev 0.04851333 0.04433025 0.04591987
#> coxph 0.04851333 0.04433025 0.04591987baseline_hazard() gives Efron’s estimate of the
cumulative baseline hazard (Breslow’s with
tie_breaking = "breslow"), the
basehaz(fit, centered = FALSE) of coxph. The
survival curve of a subject with covariates x0 is
exp(-cumulative_hazard * exp(sum(x0 * b))):
H <- cox$baseline_hazard(eta_hat)
head(H)
#> time hazard cumulative_hazard
#> 1 0.25 0.3524866 0.3524866
#> 2 0.50 0.2916936 0.6441801
#> 3 0.75 0.2682672 0.9124474
#> 4 1.00 0.3602220 1.2726694
#> 5 1.25 0.1454810 1.4181504
#> 6 1.50 0.2759841 1.6941344bh <- basehaz(fit, centered = FALSE)
all.equal(H$cumulative_hazard, bh$hazard[match(H$time, bh$time)])
#> [1] TRUEplot(NULL, xlim = c(0, max(H$time)), ylim = c(0, 1), xlab = "time", ylab = "survival")
for (x1 in c(-1, 0, 1)) {
surv <- exp(-H$cumulative_hazard * exp(b[1] * x1))
lines(c(0, H$time), c(1, surv), type = "s", lty = x1 + 2)
}
legend("topright", paste("x1 =", c(-1, 0, 1)), lty = 1:3, bty = "n")Creating a CoxDeviance sorts the data, once. Each
compute() after that is linear in n, and
repeating a call with the same linear predictor and weights returns the
cached result. A stateless function has to sort on every call. That cost
is paid at every step of an optimizer, and at every product with the
information.
We time 50 evaluations of the deviance and gradient at 100,000 observations, each at a different linear predictor.
set.seed(2)
N <- 1e5
XN <- matrix(rnorm(N * p), N, p)
etaN <- drop(XN %*% beta)
stopN <- ceiling(rexp(N, exp(etaN)) * 20) / 20
statusN <- rbinom(N, 1, 0.7)
startN <- floor(runif(N, 0, 0.5) * stopN * 40) / 40
yN <- Surv(startN, stopN, statusN)
etas <- lapply(1:50, function(i) etaN + rnorm(N, sd = 0.1))
per_call <- function(expr) {
t <- system.time(expr)[["elapsed"]]
sprintf("%.1f ms", 1000 * t / 50)
}
setup <- system.time(coxN <- CoxDeviance$new(yN))[["elapsed"]]
timings <- c(
"one object, reused" = per_call(for (e in etas) coxN$compute(e)),
"a new object for each call" = per_call(for (e in etas) CoxDeviance$new(yN)$compute(e)),
"one object, same eta again (cached)" = per_call(for (e in etas) coxN$compute(etas[[1]])),
"one information product" = per_call({
I <- coxN$information(etas[[1]])
for (e in etas) I %*% XN[, 1]
})
)
knitr::kable(data.frame(time = timings), caption = sprintf(
"Time per call, n = %d. Creating the object (the sort) took %.0f ms.",
N, 1000 * setup))| time | |
|---|---|
| one object, reused | 2.9 ms |
| a new object for each call | 21.5 ms |
| one object, same eta again (cached) | 0.7 ms |
| one information product | 1.8 ms |
The times depend on the machine, but the pattern is stable. Reusing the object avoids the sort, which costs several times as much as an evaluation. The information operator is what makes the Hessian usable at this size: as a dense matrix it would take 74.5 GB.
These binaries (installable software) and packages are in development.
They may not be fully stable and should be used with caution. We make no claims about them.
Health stats visible at Monitor.