生成具有时间依赖性协变量和时变系数的生存曲线

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 软件包在这方面受到限制。例如你必须 预先指定时变的功能形式。另一种方法是 使用Piece-wise exponential Additive Models (PAMMs)，可以通过 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 与PAMM的比较）：

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

Fit分段指数加法模型（PAM）

在这里，我拟合了带有2个时间相关协变量和线性协变量的模型 非线性时变（虽然估计值几乎是线性的） 由于受到惩罚）

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添加生存概率预测+ CI

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>由reprex package（v0.2.1）于2018-12-08创建</sup>