Cómo crear datos de supervivencia de un juguete (tiempo hasta el evento) con la censura correcta

Deseo crear un dato de supervivencia de juguetes (tiempo hasta el evento) que esté correctamente censurado y siga alguna distribución con riesgos proporcionales y un riesgo de referencia constante.

Creé los datos de la siguiente manera, pero no puedo obtener las razones de riesgo estimadas que están cerca de los valores verdaderos después de ajustar un modelo de riesgos proporcionales de Cox a los datos simulados.

¿Qué hice mal?

Códigos R:

library(survival)

#set parameters
set.seed(1234)

n = 40000 #sample size


#functional relationship

lambda=0.000020 #constant baseline hazard 2 per 100000 per 1 unit time

b_haz <-function(t) #baseline hazard
  {
    lambda #constant hazard wrt time 
  }

x = cbind(hba1c=rnorm(n,2,.5)-2,age=rnorm(n,40,5)-40,duration=rnorm(n,10,2)-10)

B = c(1.1,1.2,1.3) # hazard ratios (model coefficients)

hist(x %*% B) #distribution of scores

haz <-function(t) #hazard function
{
  b_haz(t) * exp(x %*% B)
}

c_hf <-function(t) #cumulative hazards function
{
  exp(x %*% B) * lambda * t 
}

S <- function(t) #survival function
{
  exp(-c_hf(t))
}

S(.005)
S(1)
S(5)

#simulate censoring

time = rnorm(n,10,2)

S_prob = S(time)

#simulate events

event = ifelse(runif(1)>S_prob,1,0)

#model fit

km = survfit(Surv(time,event)~1,data=data.frame(x))

plot(km) #kaplan-meier plot

#Cox PH model

fit = coxph(Surv(time,event)~ hba1c+age+duration, data=data.frame(x))

summary(fit)            

cox.zph(fit)

Resultados:

Call:
coxph(formula = Surv(time, event) ~ hba1c + age + duration, data = data.frame(x))

  n= 40000, number of events= 3043 

             coef exp(coef) se(coef)     z Pr(>|z|)    
hba1c    0.236479  1.266780 0.035612  6.64 3.13e-11 ***
age      0.351304  1.420919 0.003792 92.63  < 2e-16 ***
duration 0.356629  1.428506 0.008952 39.84  < 2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

         exp(coef) exp(-coef) lower .95 upper .95
hba1c        1.267     0.7894     1.181     1.358
age          1.421     0.7038     1.410     1.432
duration     1.429     0.7000     1.404     1.454

Concordance= 0.964  (se = 0.006 )
Rsquare= 0.239   (max possible= 0.767 )
Likelihood ratio test= 10926  on 3 df,   p=0
Wald test            = 10568  on 3 df,   p=0
Score (logrank) test = 11041  on 3 df,   p=0

pero los valores verdaderos se establecen como

B = c(1.1,1.2,1.3) # hazard ratios (model coefficients)

No tengo claro cómo genera los tiempos de su evento (que, en su caso, podría ser ) e indicadores de eventos:$<0$

time = rnorm(n,10,2) 
S_prob = S(time)
event = ifelse(runif(1)>S_prob,1,0)

Entonces, aquí hay un método genérico, seguido de algún código R.

---

Generando tiempos de supervivencia para simular modelos de riesgos proporcionales de Cox

Para generar tiempos de eventos a partir del modelo de riesgos proporcionales, podemos usar el método de probabilidad inversa (Bender et al., 2005) : si es uniforme en y si es la función de supervivencia condicional derivada del modelo de riesgos proporcionales, es decir, entonces es un hecho que la variable aleatoria tiene la función de supervivencia( 0 , 1 ) S ( $V$$(0, 1)$$S(\cdot \,|\, \mathbf{x})$

$$S(t \,|\, \mathbf{x}) = \exp \left( -H_0(t) \exp(\mathbf{x}^\prime \mathbf{\beta}) \vphantom{\Big(} \right)$$ $$T = S^{-1}(V \,|\, \mathbf{x}) = H_0^{-1} \left( - \frac{\log(V)}{\exp(\mathbf{x}^\prime \mathbf{\beta})} \right)$$ $S(\cdot \,|\, \mathbf{x})$. Este resultado se conoce como `` la transformación integral de probabilidad inversa ''. Por lo tanto, para generar un tiempo de supervivencia dado el vector covariable, es suficiente extraer de y para hacer la transformación inversa .$T \sim S(\cdot \,|\, \mathbf{x})$$v$$V \sim \mathrm{U}(0, 1)$$t = S^{-1}(v \,|\, \mathbf{x})$

---

Ejemplo [peligro de referencia de Weibull]

Deje con forma y escala . Entonces y . Siguiendo el método de probabilidad inversa, se obtiene una realización de calculando con una variable uniforme en . Usando resultados en transformaciones de variables aleatorias, uno puede notar que tiene una distribución condicional de Weibull (dada$h_0(t) = \lambda \rho t^{\rho - 1}$$\rho > 0$$\lambda > 0$$H_0(t) = \lambda t^\rho$$H^{-1}_0(t) = (\frac{t}{\lambda})^{\frac{1}{\rho}}$$T \sim S(\cdot \,|\, \mathbf{x})$

$$t = \left( - \frac{\log(v)}{\lambda \exp(\mathbf{x}^\prime \mathbf{\beta})} \right)^{\frac{1}{\rho}}$$ $v$$(0, 1)$$T$$\mathbf{x}$) con forma y escala .$\rho$$\lambda \exp(\mathbf{x}^\prime \mathbf{\beta})$

---

Código R

La siguiente función R genera un conjunto de datos con una sola covariable binaria (por ejemplo, un indicador de tratamiento). El peligro de la línea de base tiene forma de Weibull. Los tiempos de censura se extraen aleatoriamente de una distribución exponencial.$x$

# baseline hazard: Weibull

# N = sample size    
# lambda = scale parameter in h0()
# rho = shape parameter in h0()
# beta = fixed effect parameter
# rateC = rate parameter of the exponential distribution of C

simulWeib <- function(N, lambda, rho, beta, rateC)
{
  # covariate --> N Bernoulli trials
  x <- sample(x=c(0, 1), size=N, replace=TRUE, prob=c(0.5, 0.5))

  # Weibull latent event times
  v <- runif(n=N)
  Tlat <- (- log(v) / (lambda * exp(x * beta)))^(1 / rho)

  # censoring times
  C <- rexp(n=N, rate=rateC)

  # follow-up times and event indicators
  time <- pmin(Tlat, C)
  status <- as.numeric(Tlat <= C)

  # data set
  data.frame(id=1:N,
             time=time,
             status=status,
             x=x)
}

---

Prueba

Aquí hay una simulación rápida con :$\beta = -0.6$

set.seed(1234)
betaHat <- rep(NA, 1e3)
for(k in 1:1e3)
{
  dat <- simulWeib(N=100, lambda=0.01, rho=1, beta=-0.6, rateC=0.001)
  fit <- coxph(Surv(time, status) ~ x, data=dat)
  betaHat[k] <- fit$coef
}

> mean(betaHat)
[1] -0.6085473

Para la distribución de Weibull,
S (t) =$e^{-(\lambda * e^(x * \beta)*t)^\rho}$

" " será solo para log (v)$^{(1/rho)}$

así que modifiqué así

Tlat <- (- log(v))^(1 / rho) / (lambda * exp(x * beta))

si rho = 1, el resultado será el mismo.