R语言ggplot：为stat_summary中位数线添加IQR丝带/误差棒问题

现有代码可通过stat_summary绘制三组数据的中位数折线，但无法添加IQR（四分位距）对应的丝带或误差棒。涉及变量：

• 分组变量：otherside_surgery_yesno（含三组：NA、"0"、非NA）
• X轴：Jahre（年份）
• Y轴：po_constant_impaired_score_a

尝试自定义上下四分位计算函数，但geom_errorbar无法正常工作，寻求可行方案。

现有可运行代码：

both_sides %>% 
  ggplot() +
  # RTSA
  stat_summary(data = both_sides %>% filter(is.na(otherside_surgery_yesno)),
                 aes(x = Jahre, 
                   y = po_constant_impaired_score_a),
              fun = median, 
              geom = "line",
              color = "red") +
  # Healthy without surgery
  stat_summary(data = both_sides %>% filter(otherside_surgery_yesno == "0"),
                 aes(x = Jahre, 
                   y = po_constant_impaired_score_a),
              fun = median, 
              geom = "line",
              color = "darkgreen") +
  stat_summary(data = both_sides %>% filter(!is.na(otherside_surgery_yesno)),
                 aes(x = Jahre, 
                   y = po_constant_impaired_score_a),
              fun = median, 
              geom = "line",
              color = "blue") +
  theme_classic() +
  ylab("Constant Score absolute") +
  xlab("Time (years)")

尝试的失效代码：

calculate_lower <- function(data) {
  return(quantile(data, 0.25))
}

calculate_upper <- function(data) {
  return(quantile(data, 0.75))
}

geom_errorbar(
  aes(ymin = calculate_lower(data), ymax = calculate_upper(data)),
  width = 0.2
)

方法1：使用stat_summary的fun.data参数（推荐） #

无需重复调用stat_summary，先统一分组标签，再用fun.data一次性计算中位数、上下四分位，同时绘制折线和误差棒/丝带。

# 先整理分组标签，方便图例展示
both_sides <- both_sides %>%
  mutate(group = case_when(
    is.na(otherside_surgery_yesno) ~ "RTSA",
    otherside_surgery_yesno == "0" ~ "Healthy without surgery",
    !is.na(otherside_surgery_yesno) ~ "Other surgery"
  ))

# 绘制中位数折线 + IQR误差棒
both_sides %>%
  ggplot(aes(x = Jahre, y = po_constant_impaired_score_a, color = group)) +
  # IQR误差棒
  stat_summary(fun.data = function(x) {
    tibble(
      y = median(x),
      ymin = quantile(x, 0.25),
      ymax = quantile(x, 0.75)
    )
  }, geom = "errorbar", width = 0.2, position = position_dodge(0.2)) +
  # 中位数折线
  stat_summary(fun = median, geom = "line") +
  # 自定义分组颜色
  scale_color_manual(values = c(
    "RTSA" = "red", 
    "Healthy without surgery" = "darkgreen",
    "Other surgery" = "blue"
  )) +
  theme_classic() +
  labs(y = "Constant Score absolute", x = "Time (years)", color = "Group")

如果想用丝带替代误差棒，只需修改stat_summary的geom参数并调整透明度：

both_sides %>%
  ggplot(aes(x = Jahre, y = po_constant_impaired_score_a, color = group, fill = group)) +
  # IQR丝带
  stat_summary(fun.data = function(x) {
    tibble(
      y = median(x),
      ymin = quantile(x, 0.25),
      ymax = quantile(x, 0.75)
    )
  }, geom = "ribbon", alpha = 0.2, color = NA) +
  # 中位数折线
  stat_summary(fun = median, geom = "line") +
  scale_color_manual(values = c(
    "RTSA" = "red", 
    "Healthy without surgery" = "darkgreen",
    "Other surgery" = "blue"
  )) +
  scale_fill_manual(values = c(
    "RTSA" = "red", 
    "Healthy without surgery" = "darkgreen",
    "Other surgery" = "blue"
  )) +
  theme_classic() +
  labs(y = "Constant Score absolute", x = "Time (years)", color = "Group", fill = "Group")

方法2：先预处理统计数据再绘图 #

如果习惯先计算好每组每年的统计值，再用基础图层绘图：

# 预处理：计算每组每年的中位数、上下四分位
summary_data <- both_sides %>%
  mutate(group = case_when(
    is.na(otherside_surgery_yesno) ~ "RTSA",
    otherside_surgery_yesno == "0" ~ "Healthy without surgery",
    !is.na(otherside_surgery_yesno) ~ "Other surgery"
  )) %>%
  group_by(group, Jahre) %>%
  summarise(
    median_score = median(po_constant_impaired_score_a, na.rm = TRUE),
    q25 = quantile(po_constant_impaired_score_a, 0.25, na.rm = TRUE),
    q75 = quantile(po_constant_impaired_score_a, 0.75, na.rm = TRUE),
    .groups = "drop"
  )

# 绘图
summary_data %>%
  ggplot(aes(x = Jahre, y = median_score, color = group)) +
  geom_errorbar(aes(ymin = q25, ymax = q75), width = 0.2, position = position_dodge(0.2)) +
  geom_line() +
  scale_color_manual(values = c(
    "RTSA" = "red", 
    "Healthy without surgery" = "darkgreen",
    "Other surgery" = "blue"
  )) +
  theme_classic() +
  labs(y = "Constant Score absolute", x = "Time (years)", color = "Group")

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