Создайте кривую выживаемости с зависимым от времени ковариатом и изменяющимся во времени коэффициентом

Question

** Я хочу, чтобы код генерировал кривые выживания в условиях с ковариатами, зависящими от времени, и с изменяющимися во времени коэффициентами. Цель состоит в том, чтобы продемонстрировать, как метод выставления счетов влияет на отсутствие полиса страхования жизни. Это сложно в том смысле, что 1-клиент меняет метод выставления счетов (счет-фактуру или EFT) с течением времени, 2-влияние метода выставления счетов на упущение со временем стирается, и 3-влияние метода выставления счетов на упущение зависит от других ковариат. После прочтения виньетки по ковариатам, зависящим от времени, я не знаю, как сгенерировать кривые выживания из модели, в которой есть как ковариаты, зависящие от времени, так и изменяющиеся во времени коэффициенты. **

library(survival)

     Samp <- data.frame(
       id = c(143,151,680,134),
       time = c(17,16,17,18) ,
       censor= rep(1,4) , 
       covariate = seq(5,20,length.out = 4)
     )
     # Lookup provides the values of a tdc
     Lookup <- 
        data.frame(
        id =c(rep(134,2),680,143,rep(151,3)) ,
        billing.mode = c("INV",rep("EFT",2),rep("INV",2),"EFT","INV") ,
        switch.time = c(0,3,rep(0,3),2,7)
     )

    # create the tdc 
    Samp.tdc <- tmerge(data1=Samp,data2=Samp,id=id,
                    lapse=event(time,censor))
    Samp.tdc <- tmerge(data1=Samp.tdc,data2=Lookup,id=id,
                    billing.mode=tdc(switch.time,billing.mode))
   Samp.tdc$inv = as.numeric(Samp.tdc$billing.mode == "INV")

# the call looks something like this
    fit <-coxph(Surv(tstart, tstop, lapse) ~ inv + tt(inv) + covariate*inv, 
            data = Samp.tdc, 
            tt = function(x, t, ...) x * t)

Когда я говорю, что хочу создать кривые выживания, я имею в виду прогнозируемое выживание для фиксированного набора времен и ковариатных значений. Допустим, для LpsData ниже.

LpsData <- data.frame(
  tstart = rep(c(0,16,17),times=4),
  tstop = rep(16:18,times=4) ,
  lapse = 0 ,
  covariate = rep(c(10,20),each=3,times=2) ,
  inv=rep(c(0,1),each=6) ,
  curve=rep(c('eft','inv'), each=6)
)

Answer 1

Это довольно сложная проблема, и я лично нахожу возможности survival пакет ограничен в этом отношении. Например, вы должны предварительно указать функциональную форму изменения времени. Альтернативой является использование кусочно-экспоненциальных аддитивных моделей (ПАММ), которые можно оценить с помощью mgcv::gam и, таким образом, наследует всю их гибкость (+ штрафованная оценка нелинейных эффектов, включая изменяющиеся во времени эффекты).

В общем, вы должны решить, какую модель вы хотите установить. Позволять z быть вашим зависящим от времени ковариатом. Чем могут быть потенциальные модели

• линейный ковариатный эффект, линейно изменяющийся во времени, т.е. модель, указанная в вашем коде (mgcv формула: + z * t +)
• нелинейный ковариатный эффект, линейно изменяющийся во времени (формула: + s(z, by = t) +)
• линейный ковариатный эффект, нелинейно изменяющийся во времени (формула: + s(t, by = z) +)
• нелинейный, нелинейно изменяющийся во времени (формула: + te(t, z) +)

Ниже приведен пример использования pbc данные из survival пакет, который также включен в виньетку выживания для зависящих от времени ковариат (см. также https://adibender.github.io/pammtools/articles/tdcovar.html для сравнения с ПАММ):

library(survival)
library(ggplot2)
theme_set(theme_bw())
library(pammtools)
library(mgcv)

Преобразование данных

Сначала я преобразую данные в формат кусочно-экспоненциальных данных (PED):

pbc <- pbc %>% filter(id <= 312) %>%
  select(id:sex, bili, protime) %>%
  mutate(status = 1L * (status == 2))

## Transform to piece-wise exponential data (PED) format
pbc_ped <- as_ped(
  data = list(pbc, pbcseq),
  formula = Surv(time, status)~. | concurrent(bili, protime, tz_var = "day"),
  id = "id") %>% ungroup()

pbc_ped <- pbc_ped %>%
  mutate(
    log_bili = log(bili),
    log_protime = log(protime))

Пошаговая экспоненциальная аддитивная модель (PAM)

Здесь я подгоняю модель с двумя зависящими от времени ковариатами с линейными ковариатными эффектами, нелинейно изменяющимися во времени (хотя оценки являются почти линейными из-за штрафов)

pbc_pam <- gam(ped_status ~ s(tend, k = 10) + s(tend, by = log_bili) +
  s(tend, by = log_protime),
  data = pbc_ped, family = poisson(), offset = offset)

Прогноз выживания для фиксированных ковариат

Для прогноза я

• создать новый набор данных во все уникальные наблюдаемые моменты времени (для всех неопределенных ковариат будут установлены средние / модусные значения)
• добавить зависящее от времени значение log_bili в каждый момент времени
• добавить прогнозы вероятности выживания + CI, используя add_surv_prob

ndf <- make_newdata(pbc_ped, tend = unique(tend)) %>%
  mutate(log_bili = runif(n(), min(log_bili), max(log_bili))) %>%
  add_surv_prob(pbc_pam) 

Сюжет предсказал вероятности выживания

ggplot(ndf, aes(x = tend, y = surv_prob)) +
  geom_surv() +
  geom_ribbon(aes(ymin = surv_lower, ymax = surv_upper), alpha = 0.3) +
  ylim(c(0, 1))

```

<sup>Создано 2018-12-08 пакетом представлением (v0.2.1)</sup>