R语言进行逆概率加权评估竞争风险事件累积发生率（cif）并绘制累积置信区间图

竞争风险事件就是指在临床事件中出现和它竞争的结局事件，这是事件会导致原有结局的改变。比如我们想观察患者肿瘤的复发情况，但是患者在观察期突然车祸死亡，或者因其他疾病死亡，这样我们就观察不到复发情况了，这种情况下不能把缺失数据仅仅当做右删失处理，这样的话会造成数据的估值错误。本期介绍一下R cmprskcoxmsm包使用逆概率加权方法来估计边际结构模型下竞争风险事件的因果关系的治疗效果，还估计潜在结果的累积发生率函数（即风险），并提供对风险差异和风险比的推断。

我们先导入R包和数据看一下

library(cmprskcoxmsm)
follic<-read.csv("E:/r/test/follic.csv",sep=',',header=TRUE)

这是一个关于淋巴瘤患者的数据（公众号回复：淋巴瘤数据，可以获得数据），age：年龄，hgb：血红蛋白（克/升），clinstg：临床分期：1=Ⅰ期，2=Ⅱ期，ch：化疗，rt放疗，time随访时间，status：结局变量，1：复发，2：死亡，0：无反应。
我们先对数据格式进行一下整理，更改治疗名称

follic$treatment <- ifelse(follic$ch=="Y","Combination treatment","Radiation alone")
follic$clinstg <- ifelse(follic$clinstg==1,"Stage I","Stage II")

联合治疗118人，单独治疗423人

table(follic$treatment)

接下来使用doPS函数生成PS（倾向评分），逆概率权重，包括稳定权重和不稳定权重，主要是使用的公式不同，我们在既往的文章都有介绍，感兴趣的可以自己找一下

OUT1 <- doPS(dat = follic,
             Trt = "treatment",
             Trt.name = "Combination treatment",
             VARS. = c("age","hgb","clinstg"))

提取出加权后的数据

follic1 <- OUT1[["Data"]]

我们可以查看倾向评分分布

plot(OUT1)

还可以显示加权后的SMD，可以看出，调整后协变量平衡之间好了很多，基本都在0.1以内

得到权重后就是拟合边缘结构COX回归比例风险模型，这里weight.type = "Stabilized"使用的是稳定权重

tab1 <- weight_cause_cox(follic1,
                         time = "time",
                         time2 = NULL,
                         Event.var =  "status",
                         Event = "1",
                         weight.type = "Stabilized",
                         ties = NULL)
tab1

从结果中，我们可以看到估计的风险比为 0.773，95% CI (0.537, 1.112)，因此没有显着的治疗因果效应。
我们还可以从不同事件类型的数据中估计 CIF（累积发生率），CIF 95% 的置信区间通过 bootstrap 计算。 我们首先估计疾病复发的 CIF：

cif.dr <- cif_est(follic1,
                  time = "time",
                  time2 = NULL,
                  Event.var = "status",
                  Events = c("1","2"),
                  cif.event = "1",
                  weight.type = "Stabilized",
                  ties = NULL,
                  risktab = TRUE,
                  risk.time = 10)

生成了数据后，我们可以查看10年的风险比差异

risk_dr10 <- cif.dr$risk_tab

可以对整个CIF绘图

plot_est_cif(cif.dat = cif_dr,
             c("#1c9099","#756bb1"),
             ci.cif = TRUE)

如果想了解死亡的cif,只需把结局事件改一下，cif.event = “2”

cif.death <- cif_est(follic1,
                     time = "time",
                     time2 = NULL,
                     Event.var = "status",
                     Events = c("1","2"),
                     cif.event = "2",
                     weight.type = "Stabilized",
                     ties = NULL,
                     risktab = TRUE,
                     risk.time = 10)
cif_death <- cif.death$cif_data
risk_death10 <- cif.death$risk_tab

绘图

plot_est_cif(cif.dat = cif_death,
             color = c("#2c7fb8","#f03b20"),
             ci.cif = TRUE)

查看10年的风险比

risk_death10

更多精彩文章请关注公众号：零基础说科研