如何为R中调整后Kaplan-Meier曲线添加风险患者数并修改颜色

核心思路 #

adjustedCurves包的plot()返回ggplot对象，我们可以单独生成风险患者数的表格图，再用cowplot::plot_grid()将两者上下拼接。风险患者数通常基于原始队列的时间点统计，也可根据需求调整为加权后的人数。

完整代码 #

library(riskRegression); library(adjustedCurves);library(survival)
library(cowplot); library(ggplot2); library(tidyr)

set.seed(42)
sim_dat <- sim_confounded_surv(n=500, max_t=1.2)
sim_dat$group <- as.factor(sim_dat$group)
sim_dat$cluster <- sample(1:5, size=nrow(sim_dat), replace=TRUE)

cox_mod <- coxph(Surv(time, event) ~ x1 + x2 + x4 + x5 + group + cluster,  data=sim_dat, x=TRUE)

predict_fun <- function(...) {
  1 - predictRisk(...)
}

# 生成调整后生存曲线对象
adjsurv <- adjustedsurv(data=sim_dat,
                        variable="group",
                        ev_time="time",
                        event="event",
                        method="direct",
                        outcome_model=cox_mod,
                        predict_fun=predict_fun)

# 绘制调整后生存曲线，保存为ggplot对象
p_curve <- plot(adjsurv, custom_colors = c("red","blue"))

# ---------------------- 生成风险患者数表格 ----------------------
# 计算原始队列的KM曲线，提取风险人数信息
km_fit <- survfit(Surv(time, event) ~ group, data = sim_dat)
risk_data <- data.frame(
  time = km_fit$time,
  group = rep(levels(sim_dat$group), km_fit$strata),
  n_risk = km_fit$n.risk
)

# 匹配调整后曲线的时间点，过滤冗余数据
adj_times <- unique(adjsurv$adj$time)
risk_data_filtered <- risk_data[risk_data$time %in% adj_times, ]

# 转换为宽格式，方便制作表格
risk_table <- pivot_wider(risk_data_filtered, 
                          names_from = group, 
                          values_from = n_risk,
                          values_fill = 0)

# 制作风险表的ggplot图
p_risk <- ggplot(risk_table, aes(x = time)) +
  # 对应分组颜色添加风险人数文本
  geom_text(aes(label = `0`), y = 1, color = "red", hjust = 0.5) +
  geom_text(aes(label = `1`), y = 0.9, color = "blue", hjust = 0.5) +
  # 添加表头标注
  annotate("text", x = min(adj_times), y = 1.1, label = "Patients at Risk", hjust = 0, fontface = "bold") +
  annotate("text", x = min(adj_times), y = 1, label = "Group 0", hjust = 0, color = "red") +
  annotate("text", x = min(adj_times), y = 0.9, label = "Group 1", hjust = 0, color = "blue") +
  # 清理主题样式，隐藏不必要元素
  theme_minimal() +
  theme(
    axis.title = element_blank(),
    axis.text.y = element_blank(),
    axis.ticks.y = element_blank(),
    panel.grid = element_blank()
  ) +
  scale_x_continuous(limits = c(min(adj_times), max(adj_times)))

# 拼接曲线和风险表
plot_grid(p_curve, p_risk, ncol = 1, rel_heights = c(4, 1))

关键说明 #

1. 风险人数来源：这里用原始队列的survfit()结果统计风险人数，是临床报告中的常规做法；若需要加权后的调整风险人数，可基于adjsurv对象中的权重信息重新计算。
2. 样式调整：可根据需求修改p_risk中的y轴位置、颜色、字体等，确保和曲线样式统一。
3. 时间点匹配：通过adjsurv$adj$time提取调整后曲线的时间点，保证风险表和曲线的时间轴完全对齐。

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