【新增图文教程】Basics-kaplan-meier plot

[Likexin0127]

拟推荐图表名：kaplan-meier plot
图表分类：basic
图效果示例

参考代码：# 加载包
library(survival)
library(survminer) # 提供ggsurvplot()函数
library(ggplot2)

生成模拟生存数据

set.seed(123)
time <- rexp(100, rate = 0.1) # 生存时间
status <- sample(0:1, 100, replace = TRUE) # 事件状态（0=删失，1=事件）
group <- sample(c("Treatment", "Control"), 100, replace = TRUE) # 分组变量

创建生存对象

surv_obj <- Surv(time, status)

获取生存曲线数据

fit <- survfit(surv_obj ~ group, data = data.frame(time, status, group))
surv_data <- surv_summary(fit)

使用ggplot2直接绘制

ggplot(surv_data, aes(x = time, y = surv, color = strata)) +
geom_step(linewidth = 1.2) + # 阶梯线绘制生存曲线
geom_ribbon(
aes(ymin = lower, ymax = upper, fill =strata ),
alpha = 0.2,
color = NA # 隐藏置信区间边框
) +
scale_color_manual(
values = c("Control" = "#E7B800", "Treatment" = "#2E9FDF"),
name = "Group"
) +
labs(
title = "Kaplan-Meier Survival Curve",
x = "Time (days)",
y = "Survival Probability"
) +
theme_minimal() +
theme(
plot.title = element_text(size = 16, face = "bold", hjust = 0.5),
legend.position = c(0.8, 0.8),
panel.grid.minor = element_blank()
) +

添加删失标记

geom_point(
data = subset(surv_data, n.censor > 0),
aes(x = time, y = surv),
shape = "|", size = 4,
show.legend = FALSE
)

Originally posted by @yxywalab in #61

[yxywalab]

---

title: "Basics-kaplan-meier plot"

KM plot

生存曲线图

Example

生存分析研究的是某个事件发生之前过去的时间，在临床研究中最常见的应用就是死亡率的估计(预测患者的生存时间)，不过生存分析也可以应用于其他领域如机械故障时间等。

环境配置

• 系统要求 跨平台（Linux/MacOS/Windows）

• 编程语言: R

• 依赖资源: （填充可视化教程依赖的R包或其他资源）

#代码示例----- 
# Installing necessary packages
if (!requireNamespace("survival", quietly = TRUE)) {
  install.packages("survival")}
if (!requireNamespace("survminer", quietly = TRUE)) {
  install.packages("survminer")}
if (!requireNamespace("ggplot2", quietly = TRUE)) {
  install.packages("ggplot2")}
if (!requireNamespace("dplyr", quietly = TRUE)) {
  install.packages("dplyr")}
if (!requireNamespace("tidyr", quietly = TRUE)) {
  install.packages("tidyr")}
if (!requireNamespace("zoo", quietly = TRUE)) {
  install.packages("zoo")}
if (!requireNamespace("patchwork", quietly = TRUE)) {
  install.packages("patchwork")}

# Loading the libraries
library(survival)    
library(survminer)   
library(ggplot2)     
library(dplyr)
library(tidyr)
library(zoo)
library(patchwork)

数据准备

• 需包含R内置的数据集（如iris、penguins）和生物医学相关数据集（如组学数据、生存信息、临床指标等）。
• 生物医学相关数据集需上传至Bizard腾讯云以便获取插入教程的链接，来自于公共数据集的数据最佳，若由个人/组织提供需确保数据能够被公开。数据集大小需小于1MB。

# 使用内置lung数据集（来自survival包）
data("lung")
# 数据预处理
surv_data <- lung %>%
  mutate(
    status = ifelse(status == 2, 1, 0),  # 转换状态编码（1=事件）
    sex = factor(sex, labels = c("Male", "Female")),
    group = sample(c("Treatment", "Placebo"), n(), replace = TRUE)
  )

# 查看数据结构
glimpse(surv_data)

# 生存时间分布
summary(surv_data$time)

# 拟合生存曲线
fit <- survfit(Surv(time, status) ~ group, data = surv_data)

# 提取曲线数据
surv_curve <- surv_summary(fit) 


# 计算log-rank检验P值
diff <- survdiff(Surv(time, status) ~ group, data = surv_data)
p_value <- signif(1 - pchisq(diff$chisq, length(diff$n)-1), 3)

可视化

1. 基础绘图

使用基础函数绘制图片的图注和简介。

基础绘图代码示例-----

##| label: fig-basicKM
#| fig-cap: "基础生存曲线"

p1<-ggplot(surv_curve, aes(x = time, y = surv, color = strata)) +
geom_step(linewidth = 1) +
labs(x = "Time (Months)", y = "Survival Probability") +
scale_y_continuous(labels = scales::percent)
p1

# 代码示例（以补充参数bins为例）-----
## 自定义美学映射
group_colors <- c("Treatment" = "#E64B35", "Placebo" = "#3182BD")
line_types <- c("Treatment" = "solid", "Placebo" = "dashed")

# 完整绘图代码
p_km <- ggplot(surv_curve, aes(x = time, color = group, fill = group)) +
      # 先绘制置信区间
      geom_ribbon(aes(ymin = lower, ymax = upper), 
                  alpha = 0.15, 
                  colour = NA) +
      # 再绘制生存曲线
      geom_step(aes(y = surv, linetype = group), 
                linewidth = 1.2) +
      # 颜色映射
      scale_color_manual(
        values = group_colors,
        name = "Treatment Group",
        labels = c("Placebo", "Treatment")
      ) +
      # 填充色映射
      scale_fill_manual(
        values = group_colors,
        guide = "none"
      ) +
      # 线型映射
      scale_linetype_manual(
        values = line_types,
        guide = "none"  # 与颜色共用图例
      ) +
      # 坐标轴优化
      scale_x_continuous(
        name = "Time (Months)",
        expand = c(0, 0),
        breaks = seq(0, 1000, by = 100)
      ) +
      scale_y_continuous(
        name = "Survival Probability",
        labels = scales::percent,
        limits = c(0, 1)
      ) +
      # 主题设置
      theme_classic(base_size = 12) +
      theme(
        legend.position = c(0.85, 0.85),
        legend.background = element_rect(fill = "white", colour = "grey50"),
        panel.grid.major.y = element_line(colour = "grey90")
      )
p_km

2. 更多进阶图表

# 进阶绘图代码示例-----
#| label: fig-enhancedKM
#| fig-cap: "美化版生存曲线"

# ----------------------------
# 风险表数据生成
# ----------------------------
# 生成分位数断点（自动适应数据分布）
custom_breaks <- quantile(surv_curve$time, 
                          probs = seq(0, 1, 0.25), 
                          na.rm = TRUE) %>%
  unique()  # 确保断点唯一

# 正确生成区间标签的方法
time_labels <- paste0(
  round(custom_breaks[-length(custom_breaks)]),  # 起始点（排除最后一个）
  "-",
  round(custom_breaks[-1])  # 结束点（排除第一个）
)

# 生成分段式风险表数据 --------------------------------------------------------
risk_table_segmented <- surv_curve %>%
  mutate(
    time_interval = cut(time,
                        breaks = custom_breaks,
                        include.lowest = TRUE,
                        right = FALSE,
                        labels = time_labels)
  ) %>%
  group_by(group, time_interval) %>%
  summarise(
    n_risk = ifelse(all(is.na(n.risk)), 0, max(n.risk, na.rm = TRUE)),  # 取区间内最大风险人数
    .groups = "drop"
  ) %>%
  complete(group, time_interval, fill = list(n_risk = 0)) %>%
  # 4. 添加总计行（修复语法）
  bind_rows(
    group_by(., group) %>%
      summarise(
        time_interval = "Total",
        n_risk = sum(n_risk, na.rm = TRUE),
        .groups = "drop"
      )
  ) %>%
  mutate(
    group = factor(group, levels = c("Treatment", "Placebo")),
    time_interval = factor(time_interval, levels = c(time_labels, "Total") )
  )

# 带边框的分段式风险表绘图 ----------------------------------------------------
risk_table_plot <- ggplot(risk_table_segmented, 
                          aes(x = time_interval, y = group)) +
  # # 单元格背景（带边框）
  # geom_tile(color = "gray50", fill = "white", linewidth = 0.5, 
  #           width = 0.95, height = 0.95) +
  # 数值标签
  geom_text(aes(label = n_risk), size = 4.5, fontface = "bold", color = "black") +
  # 列标题样式
  scale_x_discrete(
    name = "Time Interval (Months)",
    position = "top",
    expand = expansion(add = 0.5)
  ) +
  scale_y_discrete(
    name = NULL, 
    limits = rev,
    labels = c("Treatment\nGroup", "Placebo\nGroup")  # 添加分组标签
  ) +
  # 颜色系统
  scale_fill_manual(values = group_colors, guide = "none") +
  # 主题系统
  theme_minimal(base_size = 12) +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 0, color = "black"),
    axis.text.y = element_text(
      color = group_colors,
      face = "bold",
      margin = margin(r = 15)
    ),
    panel.grid = element_blank(),
    plot.margin = margin(t = 30, b = 5, unit = "pt"),
    axis.title.x = element_text(margin = margin(t = 15))
  ) +
  # 添加外边框
  annotate("rect",
           xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = Inf,
           color = "gray30", fill = NA, linewidth = 0.8)
risk_table_plot

# ----------------------------
# 绘图参数设置
# ----------------------------
group_colors <- c("Treatment" = "#E64B35", "Placebo" = "#3182BD")
theme_set(theme_minimal(base_size = 12))

# ----------------------------
# KM生存曲线绘制
# ----------------------------
p_km <- ggplot(surv_curve, aes(x = time, color = group, fill = group)) +
  # 先绘制置信区间
  geom_ribbon(aes(ymin = lower, ymax = upper), 
              alpha = 0.15, 
              colour = NA) +
  # 再绘制生存曲线
  geom_step(aes(y = surv, linetype = group), 
            linewidth = 1.2) +
  # 颜色映射
  scale_color_manual(
    values = group_colors,
    name = "Treatment Group",
    labels = c("Placebo", "Treatment")
  ) +
  # 填充色映射
  scale_fill_manual(
    values = group_colors,
    guide = "none"
  ) +
  # 线型映射
  scale_linetype_manual(
    values = line_types,
    guide = "none"  # 与颜色共用图例
  ) +
  # 坐标轴优化
  scale_x_continuous(
    name = "Time (Months)",
    expand = c(0, 0),
    breaks = seq(0, 1000, by = 100)
  ) +
  scale_y_continuous(
    name = "Survival Probability",
    labels = scales::percent,
    limits = c(0, 1)
  ) +
  # 主题设置
  theme_classic(base_size = 12) +
  theme(
    legend.position = c(0.85, 0.85),
    legend.background = element_rect(fill = "white", colour = "grey50"),
    panel.grid.major.y = element_line(colour = "grey90")
  )
p_km

# ----------------------------
# 图形组合
# ----------------------------
final_plot <- p_km / risk_table_plot + 
  plot_layout(heights = c(3, 0.4))

final_plot

应用

1. 多组别比较

生成基础三组数据 ### ---------------------------------------------------------

set.seed(2023)
n <- 300

trials_data <- tibble(
id = 1:n,
arm = factor(sample(c("A", "B", "C"), n, replace = TRUE, prob = c(0.3, 0.4, 0.3)),
levels = c("A", "B", "C")),

生成基线生物标志物水平（与生存相关）

biomarker = rnorm(n, mean = case_when(
arm == "A" ~ 50,
arm == "B" ~ 65,
arm == "C" ~ 60
), sd = 10),

生成生存时间（与生物标志物相关）

true_time = pmax(1, rweibull(n, shape = 1.2,
scale = 1530.4375(biomarker/50)^0.8)),

添加随机删失

censor_time = runif(n, 630.4375, 2430.4375),
obs_time = pmin(true_time, censor_time),
status = as.numeric(true_time <= censor_time)
)

三组KM曲线 ------------------------------------------------------------

fit_tri <- survfit(Surv(obs_time, status) ~ arm, data = trials_data)

surv_tri <- surv_summary(fit_tri) %>%
mutate(
arm = gsub("arm=", "", strata),
time_m = round(time / 30.4375, 1),
arm = factor(arm, levels = c("A", "B", "C"))
)

ggplot(surv_tri, aes(x = time_m, y = surv, color = arm)) +
geom_step(linewidth = 1.2) +
geom_ribbon(aes(ymin = lower, ymax = upper, fill = arm), alpha = 0.15) +
scale_color_manual(
values = c("#1B9E77", "#D95F02", "#7570B3"),
name = "Treatment",
labels = c("Standard", "New Drug", "Combination")
) +
labs(x = "Time (Months)", y = "Survival Probability") +
theme_classic() +
theme(legend.position = c(0.85, 0.8))

2. 多组别分面

生物标志物分层处理 -----------------------------------------------------

trials_data <- trials_data %>%
mutate(
biomarker_group = cut(biomarker,
breaks = quantile(biomarker, probs = c(0, 0.3, 0.7, 1)),
labels = c("Low", "Medium", "High"),
include.lowest = TRUE)
)

分层生存分析模型

fit_biomarker <- survfit(
Surv(obs_time, status) ~ arm + biomarker_group,
data = trials_data
)

数据整理关键步骤

surv_biomarker <- surv_summary(fit_biomarker) %>%
separate(strata, into = c("arm", "biomarker"), sep = ", ") %>%
mutate(
arm = gsub("arm=", "", arm),
biomarker = gsub("biomarker_group=", "", biomarker),
time_m = time / 30.4375,
biomarker = factor(biomarker, levels = c("Low", "Medium", "High"))
)

分面可视化

ggplot(surv_biomarker, aes(x = time_m, y = surv, color = arm)) +
geom_step(linewidth = 1) +
facet_grid(~ biomarker_group,
labeller = labeller(biomarker = c(
Low = "Low Biomarker (≤30%)",
Medium = "Medium Biomarker (30-70%)",
High = "High Biomarker (≥70%)"
))) +
scale_color_manual(
values = c("#1B9E77", "#D95F02", "#7570B3"),
name = "Treatment Arm",
labels = c("Standard", "New Drug", "Combination")
) +
labs(
x = "Follow-up Time (Months)",
y = "Survival Probability",
title = "Treatment Effect Stratified by Biomarker Level"
) +
theme_minimal() +
theme(
strip.background = element_rect(fill = "grey95"),
strip.text = element_text(face = "bold", size = 11),
panel.spacing = unit(1.5, "lines"),
legend.position = "bottom"
)

参考文献

1.Kassambara A, et al. Survminer: Drawing Survival Curves using ggplot2. JOSS 2017

2.Wickham H. ggplot2: Elegant Graphics for Data Analysis. Springer 2016
## 共享者

-   **编辑**: 易旭洋。

• 审阅: 审阅者姓名。

[Likexin0127]

感谢您的投稿！我对您的图文教程还有如下建议：

1. 数据准备部分对R内置数据集的表述有误，请明确使用的R数据集（lung），删去模板中自带文字；
2. 基础绘图代码示例中代码框未显示；
3. 典型图片/不包含任何变体的图片请附上legend；
4. 应用模块中多出代码框显示不全；
5. 文末编辑审阅处格式混乱，请复核。

[JerryBian369]

@yxywalab 您好！更改后请上传qmd文件，谢谢！