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

Я хочу, чтобы код генерировал кривые выживания в среде с обоими

  • зависящие от времени ковариаты и
  • коэффициенты, меняющиеся во времени.

Цель состоит в том, чтобы продемонстрировать, как метод выставления счетов влияет на срок действия полиса страхования жизни. Это сложно в том

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

survival-analysis cox-regression survival
person PdV    schedule 17.05.2018    source источник

Ответы (1)


arrow_upward
1
arrow_downward

Это относительно сложная проблема, и я лично считаю, что возможности пакета 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/article/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 в каждый момент времени
  • добавить прогнозы вероятности выживания + ДИ, используя 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))

`` `

Создано 8 декабря 2018 г. пакетом REPEX (v0.2.1)

person adibender    schedule 08.12.2018