speed up a handmade Cox model fit (v.s. `survival::coxph`) - r

Question

Below, I compare the results from an R-function with my own code. The algorithm simply consists of maximising a function of many parameters (here, 19). My code defines the function and uses nlm for optimisation. Fortunately, both return the same result. However, the R-function is amazingly quick. I therefore suspect I can do better than using nlm (or a similar optimisation routine in R). Any idea?
Here is some survival data that can be fitted with a Cox model. To do so, one needs to maximise the partial log-likelihood (3rd equation in the wikipedia link).
InR, this can be done with coxph() (part of the survival package):
> library(survival)
> fmla <- as.formula(paste("Surv(time, event) ~ ",
+ paste(names(data)[-(1:3)], collapse=" +")))
> mod <- coxph(formula=fmla, data=data)
> round(mod$coef, 3)
x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15
-0.246 -0.760 0.089 -0.033 -0.138 -0.051 -0.484 -0.537 -0.620 -0.446 -0.204 -0.112 -0.089 -0.451 0.043
x16 x17 x18 x19
0.106 -0.015 -0.245 -0.653
This can be checked by explicitly writing the partial log-likelihood and by using some numerical optimisation routine. Here is some crude code which does this job.
The code has been edited based on the comments I received
> #------ minus partial log-lik ------
> Mpll <- function(beta, data)
+ #!!!data must be ordered by increasing time!!!
+ #--> data <- data[order(data$time), ]
+ {
+ #preparation
+ N <- nrow(data)
+ linpred <- as.matrix(data[, -(1:3)]) %*% beta
+
+ #pll
+ pll <- sum(sapply(X=which(data$event == 1), FUN=function(j)
+ linpred[j] - log(sum(exp(linpred[j:N])))))
+
+ #output
+ return(- pll)
+ }
> #-----------------------------------
>
> data <- data[order(data$time), ]
> round(nlm(f=Mpll, p=rep(0, 19), data=data)$estimate, 3)
[1] -0.246 -0.760 0.089 -0.033 -0.138 -0.051 -0.484 -0.537 -0.620 -0.446 -0.204 -0.112 -0.089 -0.451
[15] 0.043 0.106 -0.015 -0.245 -0.653
OK, it works... but it is much much slower!
Does anyone have an idea on what is done within coxph() to make it so fast?

Answer 1

Here is a vectorized version of your code.
Mpll2 <- function(beta, data) {
X <- as.matrix(data[, -(1:3)])
a <- X %*% beta
b <- log(rev(cumsum(rev(exp(a)))))
-sum((a - b)[data$event==1])
}
And here is a simple test of the run times.
data <- data[order(data$time), ] # No reason to order every time
# Yours
system.time(round(nlm(f=Mpll, p=rep(0, 19), data=data)$estimate, 3))
# user system elapsed
# 2.77 0.01 2.79
# Vectorized
system.time(round(nlm(f=Mpll2, p=rep(0, 19), data=data)$estimate, 3))
# user system elapsed
# 0.28 0.00 0.28
# Optimized C code
fmla <- as.formula(paste("Surv(time, event) ~ ",
paste(names(data)[-(1:3)], collapse=" +")))
system.time(round(coxph(formula=fmla, data=data)$coef,3))
# user system elapsed
# 0.02 0.00 0.03
So, about an order of magnitude difference between each type. C is very fast, and you are never going to approach those speeds in R. But C is harder to write.