올바른 검열을 통해 완구 생존 (이벤트 시간) 데이터를 생성하는 방법


12

올바른 검열을 받고 비례 위험과 일정한 기준 위험으로 일부 분포를 따르는 완구 생존 (이벤트 시간) 데이터를 작성하려고합니다.

다음과 같이 데이터를 만들었지 만 Cox 비례 위험 모델을 시뮬레이션 된 데이터에 적용한 후 실제 값에 가까운 예상 위험 비율을 얻을 수 없습니다.

내가 뭘 잘못 했어?

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)

결과 :

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

그러나 진정한 값은

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

1
귀하의 작업을 위해, 빠른 시작은 기존의 시뮬레이션 패키지를 사용하는 것입니다 : cran.r-project.org/web/packages/survsim/index.html
zhanxw

답변:


19

<0

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

여기에 일반적인 방법과 R 코드가 있습니다.


콕스 비례 위험 모델을 시뮬레이션하기 위해 생존 시간 생성

V(0,1)S(|x)

S(t|x)=exp(H0(t)exp(xβ)()
T=S1(V|x)=H01(log(V)exp(xβ))
S(|x)TS(|x)vVU(0,1)t=S1(v|x)

예 [Weibull 기준선 위험]

h0(t)=λρtρ1ρ>0λ>0H0(t)=λtρH01(t)=(tλ)1ρTS(|x)

t=(log(v)λexp(xβ))1ρ
v(0,1)Txρλexp(xβ)

R 코드

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)
}

테스트

β=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

훌륭한 답변에 감사드립니다. 나는 이벤트 시간을 무작위 화 한 후 이벤트 상태를 가져 와서 이벤트 시간을 엉망으로 만들었다는 것을 깨달았습니다.
stats_newb

지수 분포에서 검열 시간을 얻는 특별한 이유가 있습니까?
pthao

@pthao : 특별한 이유가 없습니다 (지수 분포를 사용한 그림
일뿐입니다

1
검열 시간에 대한 분포를 선택하기위한 지침이 있습니까?
pthao

@ocram 흥미롭게도, flexsurvreg(Surv(time, status) ~ x, data=dat, dist = "weibull")동일한 시뮬레이션 데이터를 실행할 때 계수는로 나타납니다 0.6212. 왜 이런거야?
-nor

3


e(λe(xβ)t)ρ

(1/rho)

그래서 이렇게 수정했습니다

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

rho = 1이면 결과는 같습니다.

당사 사이트를 사용함과 동시에 당사의 쿠키 정책개인정보 보호정책을 읽고 이해하였음을 인정하는 것으로 간주합니다.
Licensed under cc by-sa 3.0 with attribution required.