是否有可拟合带IPW的竞争风险生存曲线的R函数？

核心思路 #

竞争风险下的IPW分析，核心是先基于暴露/干预因素计算个体的逆概率权重，再将权重代入竞争风险模型中拟合，最终得到加权后的累积发生率曲线（CIF）。

用survival包实现 #

survival包可通过手动计算权重，结合多状态生存对象实现加权竞争风险分析。

步骤1：计算倾向得分与IPW权重 #

假设数据中treat为分组变量（0/1），cov1/cov2/cov3为协变量：

# 拟合倾向得分模型
ps_model <- glm(treat ~ cov1 + cov2 + cov3, data = your_data, family = binomial)
your_data$ps <- predict(ps_model, type = "response")

# 计算IPW权重
your_data$ipw_weight <- ifelse(your_data$treat == 1, 1/your_data$ps, 1/(1 - your_data$ps))

# 可选：计算稳定IPW权重（降低方差）
your_data$stable_ipw <- ifelse(your_data$treat == 1, 
                               mean(your_data$treat)/your_data$ps, 
                               mean(1 - your_data$treat)/(1 - your_data$ps))

步骤2：拟合加权的竞争风险模型并绘制曲线 #

用Surv创建多状态生存对象（event编码：0=删失，1=目标结局，2=竞争结局），再通过survfit计算加权累积发生率：

# 创建多状态生存对象
surv_obj <- Surv(time = your_data$time, event = your_data$event, type = "mstate")

# 拟合加权累积发生率
weighted_cif <- survfit(surv_obj ~ treat, data = your_data, weights = ipw_weight)

# 绘制曲线
plot(weighted_cif, col = c("red", "blue"), lwd = 2, 
     xlab = "时间", ylab = "累积发生率")
legend("topright", legend = c("暴露组", "非暴露组"), col = c("red", "blue"), lwd = 2)

用rms包实现 #

rms包的crr函数支持直接传入权重，可拟合加权Fine-Gray模型，且能生成加权CIF曲线。

步骤1：计算IPW权重（同survival包步骤1） #

# 拟合倾向得分模型并计算权重
ps_model <- glm(treat ~ cov1 + cov2 + cov3, data = your_data, family = binomial)
your_data$ps <- predict(ps_model, type = "response")
your_data$ipw_weight <- ifelse(your_data$treat == 1, 1/your_data$ps, 1/(1 - your_data$ps))

步骤2：拟合加权Fine-Gray模型 #

library(rms)

# 构建竞争风险模型
crr_model <- crr(ftime = your_data$time, 
                 fstatus = your_data$event,  # 0=删失，1=目标结局，2=竞争结局
                 cov1 = your_data$treat, 
                 weights = your_data$ipw_weight,
                 failcode = 1,  # 指定感兴趣的结局编码
                 cencode = 0)   # 指定删失编码

# 查看模型结果
summary(crr_model)

步骤3：绘制加权累积发生率曲线 #

# 生成加权CIF预测
weighted_surv <- survfit(crr_model, newdata = data.frame(treat = c(0, 1)))

# 绘制曲线
plot(weighted_surv, col = c("green", "purple"), lwd = 2,
     xlab = "时间", ylab = "目标结局累积发生率")
legend("topright", legend = c("非暴露组", "暴露组"), col = c("green", "purple"), lwd = 2)

注意事项 #

• 权重检验：建议绘制权重直方图，避免极端权重影响结果稳定性，必要时可对权重进行截断处理。
• 假设验证：竞争风险模型需满足比例风险假设，可通过加权Schöenfeld残差检验。

内容的提问来源于stack exchange，提问作者Devanto