Il modello di regressione logistica presuppone che la risposta sia una prova di Bernoulli (o più generalmente un binomio, ma per semplicità lo terremo 0-1). Un modello di sopravvivenza presuppone che la risposta sia in genere un momento dell'evento (di nuovo, ci sono generalizzazioni di questo che salteremo). Un altro modo per dirlo è che le unità stanno attraversando una serie di valori fino a quando si verifica un evento. Non è che una moneta sia effettivamente lanciata in modo discreto in ogni punto. (Ciò potrebbe accadere, ovviamente, ma poi avresti bisogno di un modello per misure ripetute, forse un GLMM.)
Il tuo modello di regressione logistica prende ogni morte come un lancio di monete che si è verificato a quell'età e ha avuto la coda. Allo stesso modo, considera ogni dato censurato come un singolo lancio di monete che si è verificato all'età specificata e si è presentato alla testa. Il problema qui è che ciò è incompatibile con ciò che i dati sono realmente.
Ecco alcuni grafici dei dati e dell'output dei modelli. (Si noti che capovolgo le previsioni dal modello di regressione logistica alla previsione di essere in modo che la linea corrisponda al diagramma della densità condizionale.)
library(survival)
data(lung)
s = with(lung, Surv(time=time, event=status-1))
summary(sm <- coxph(s~age, data=lung))
# Call:
# coxph(formula = s ~ age, data = lung)
#
# n= 228, number of events= 165
#
# coef exp(coef) se(coef) z Pr(>|z|)
# age 0.018720 1.018897 0.009199 2.035 0.0419 *
# ---
# Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
#
# exp(coef) exp(-coef) lower .95 upper .95
# age 1.019 0.9815 1.001 1.037
#
# Concordance= 0.55 (se = 0.026 )
# Rsquare= 0.018 (max possible= 0.999 )
# Likelihood ratio test= 4.24 on 1 df, p=0.03946
# Wald test = 4.14 on 1 df, p=0.04185
# Score (logrank) test = 4.15 on 1 df, p=0.04154
lung$died = factor(ifelse(lung$status==2, "died", "alive"), levels=c("died","alive"))
summary(lrm <- glm(status-1~age, data=lung, family="binomial"))
# Call:
# glm(formula = status - 1 ~ age, family = "binomial", data = lung)
#
# Deviance Residuals:
# Min 1Q Median 3Q Max
# -1.8543 -1.3109 0.7169 0.8272 1.1097
#
# Coefficients:
# Estimate Std. Error z value Pr(>|z|)
# (Intercept) -1.30949 1.01743 -1.287 0.1981
# age 0.03677 0.01645 2.235 0.0254 *
# ---
# Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
#
# (Dispersion parameter for binomial family taken to be 1)
#
# Null deviance: 268.78 on 227 degrees of freedom
# Residual deviance: 263.71 on 226 degrees of freedom
# AIC: 267.71
#
# Number of Fisher Scoring iterations: 4
windows()
plot(survfit(s~1))
windows()
par(mfrow=c(2,1))
with(lung, spineplot(age, as.factor(status)))
with(lung, cdplot(age, as.factor(status)))
lines(40:80, 1-predict(lrm, newdata=data.frame(age=40:80), type="response"),
col="red")
Può essere utile considerare una situazione in cui i dati erano appropriati per un'analisi di sopravvivenza o una regressione logistica. Immagina uno studio per determinare la probabilità che un paziente venga riammesso in ospedale entro 30 giorni dalla dimissione secondo un nuovo protocollo o standard di cura. Tuttavia, tutti i pazienti sono seguiti alla riammissione e non vi è censura (questo non è terribilmente realistico), quindi il tempo esatto per la riammissione potrebbe essere analizzato con analisi di sopravvivenza (vale a dire, un modello di rischi proporzionali di Cox qui). Per simulare questa situazione, userò le distribuzioni esponenziali con i tassi .5 e 1 e userò il valore 1 come limite per rappresentare 30 giorni:
set.seed(0775) # this makes the example exactly reproducible
t1 = rexp(50, rate=.5)
t2 = rexp(50, rate=1)
d = data.frame(time=c(t1,t2),
group=rep(c("g1","g2"), each=50),
event=ifelse(c(t1,t2)<1, "yes", "no"))
windows()
plot(with(d, survfit(Surv(time)~group)), col=1:2, mark.time=TRUE)
legend("topright", legend=c("Group 1", "Group 2"), lty=1, col=1:2)
abline(v=1, col="gray")
with(d, table(event, group))
# group
# event g1 g2
# no 29 22
# yes 21 28
summary(glm(event~group, d, family=binomial))$coefficients
# Estimate Std. Error z value Pr(>|z|)
# (Intercept) -0.3227734 0.2865341 -1.126475 0.2599647
# groupg2 0.5639354 0.4040676 1.395646 0.1628210
summary(coxph(Surv(time)~group, d))$coefficients
# coef exp(coef) se(coef) z Pr(>|z|)
# groupg2 0.5841386 1.793445 0.2093571 2.790154 0.005268299
In questo caso, vediamo che il valore p del modello di regressione logistica ( 0.163) era superiore al valore p di un'analisi di sopravvivenza ( 0.005). Per esplorare ulteriormente questa idea, possiamo estendere la simulazione per stimare la potenza di un'analisi di regressione logistica rispetto a un'analisi di sopravvivenza e la probabilità che il valore p dal modello Cox sarà inferiore al valore p dalla regressione logistica . Userò anche 1.4 come soglia, in modo da non svantaggiare la regressione logistica usando un valore soglia non ottimale:
xs = seq(.1,5,.1)
xs[which.max(pexp(xs,1)-pexp(xs,.5))] # 1.4
set.seed(7458)
plr = vector(length=10000)
psv = vector(length=10000)
for(i in 1:10000){
t1 = rexp(50, rate=.5)
t2 = rexp(50, rate=1)
d = data.frame(time=c(t1,t2), group=rep(c("g1", "g2"), each=50),
event=ifelse(c(t1,t2)<1.4, "yes", "no"))
plr[i] = summary(glm(event~group, d, family=binomial))$coefficients[2,4]
psv[i] = summary(coxph(Surv(time)~group, d))$coefficients[1,5]
}
## estimated power:
mean(plr<.05) # [1] 0.753
mean(psv<.05) # [1] 0.9253
## probability that p-value from survival analysis < logistic regression:
mean(psv<plr) # [1] 0.8977
Quindi il potere della regressione logistica è inferiore (circa il 75%) rispetto all'analisi di sopravvivenza (circa il 93%), e il 90% dei valori p dall'analisi di sopravvivenza era inferiore ai corrispondenti valori p dalla regressione logistica. Prendendo in considerazione i tempi di ritardo, invece che appena inferiore o superiore a qualche soglia si ottiene una maggiore potenza statistica come si era intuito.