Включить Weibull Fit в ggsurvplot

Я хотел бы подогнать кривую Вейбулла к некоторым данным событий, а затем включить подобранную кривую Вейбулла в график выживаемости, построенный с помощью Survminer :: ggsurvplot. Есть идеи как? Вот пример для работы:

Функция для моделирования данных 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)
}

генерировать данные

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
}

#Estimate a survival function
survfit(Surv(as.numeric(time), x)~1, data=dat) -> out0

#plot    

library(survminer)
ggsurvplot(out0, data = dat, risk.table = TRUE)

gg1 <- ggsurvplot(
  out0,                     # survfit object with calculated statistics.
  data = dat,  # data used to fit survival curves. 
  risk.table = TRUE,       # show risk table.
  pval = TRUE,             # show p-value of log-rank test.
  conf.int = TRUE,         # show confidence intervals for 
  # point estimaes of survival curves.
  xlim = c(0,2000),        # present narrower X axis, but not affect
  # survival estimates.
  break.time.by = 500,     # break X axis in time intervals by 500.
  ggtheme = theme_minimal(), # customize plot and risk table with a theme.
  risk.table.y.text.col = T, # colour risk table text annotations.
  risk.table.y.text = FALSE,
  surv.median.line = "hv",
  color = "darkgreen",
  conf.int.fill = "lightblue",
  title = "Survival probability",# show bars instead of names in text annotations
  # in legend of risk table
)
gg1

введите здесь описание изображения


person jonas    schedule 11.04.2017    source источник


Ответы (2)


Насколько я понимаю, в данный момент это невозможно сделать с ggsurvplot.

Я создал проблему с запросом этой функции: https://github.com/kassambara/survminer/issues/276

Вы можете построить кривые выживаемости модели Вейбулла с помощью ggplot2 следующим образом:

library("survival")
wbmod <- survreg(Surv(time, status) ~ x, data = dat)
s <- seq(.01, .99, by = .01)
t_0 <- predict(wbmod, newdata = data.frame(x = 0), 
                 type = "quantile", p = s)
t_1 <- predict(wbmod, newdata = data.frame(x = 1), 
                type = "quantile", p = s)

smod <- data.frame(time = c(t_0, t_1), 
                   surv = rep(1 - s, times = 2), 
                   strata = rep(c(0, 1), each = length(s)),
                   upper = NA, lower = NA)

head(surv_summary(cm))

library("ggplot2")
ggplot() + 
  geom_line(data = smod, aes(x = time, y = surv, color = factor(strata))) +
  theme_classic()

введите описание изображения здесь Однако, насколько мне известно, вы не можете использовать Survminer (пока):

library("survminer")

# wrong:
ggsurvplot(smod) 

# does not work:
gg1$plot + geom_line(data = smod, aes(x = time, y = surv, color = factor(strata)))
person Heidi    schedule 02.01.2018
comment
Сейчас он находится в стадии разработки. Я создал запрос на перенос, который был принят. В следующем выпуске CRAN это должно быть возможно :) - person Heidi; 25.07.2018

Следующее работает для меня. Вероятно, это заслуга Хайди, которая заполнила запрос функции. Надеюсь, кому-то это пригодится.

library(survminer)
library(tidyr)

s <- with(lung,Surv(time,status))
sWei <- survreg(s ~ as.factor(sex),dist='weibull',data=lung)
fKM <- survfit(s ~ sex,data=lung)

pred.sex1 = predict(sWei, newdata=list(sex=1),type="quantile",p=seq(.01,.99,by=.01))
pred.sex2 = predict(sWei, newdata=list(sex=2),type="quantile",p=seq(.01,.99,by=.01))

df = data.frame(y=seq(.99,.01,by=-.01), sex1=pred.sex1, sex2=pred.sex2)
df_long = gather(df, key= "sex", value="time", -y)

p = ggsurvplot(fKM, data = lung, risk.table = T)
p$plot = p$plot + geom_line(data=df_long, aes(x=time, y=y, group=sex))

введите здесь описание изображения

person otwtm    schedule 27.05.2020