如何用purrr::map为stat QQ图添加分组色线并批量绘制

问题复现 #

先复现你遇到的报错场景，示例代码如下：

library(tidyverse)

# 生成示例数据
set.seed(123)
df <- tibble(
  value = rnorm(1000),
  group1 = sample(c("A", "B", "C"), 1000, replace = TRUE),
  group2 = sample(c("X", "Y"), 1000, replace = TRUE),
  group3 = sample(c("Low", "Medium", "High"), 1000, replace = TRUE),
  group4 = sample(c("Yes", "No"), 1000, replace = TRUE)
)

# 定义可复用图层
gglayers <- list(
  geom_point(alpha = 0.6),
  stat_qq_line(color = "red", size = 1),
  theme_minimal(),
  labs(x = "理论分位数", y = "样本分位数")
)

# 分组变量与对应标题
group_vars <- c("group1", "group2", "group3", "group4")
plot_titles <- paste("按", group_vars, "分组的QQ图")

# 报错的批量绘图代码
plots <- map2(group_vars, plot_titles, ~{
  ggplot(df, aes(sample = value, color = .x)) +
    gglayers +
    ggtitle(.y)
})

运行后会触发美学映射长度不匹配的错误，原因是直接传入字符串.x作为颜色映射，ggplot会把它当成单一颜色值，而非映射数据列。

解决方案1：修复美学映射错误 #

使用.data[[.x]]语法动态引用分组变量，让ggplot正确识别数据列映射：

plots <- map2(group_vars, plot_titles, ~{
  ggplot(df, aes(sample = value, color = .data[[.x]])) +
    gglayers +
    ggtitle(.y) +
    labs(color = .x) # 给图例设置对应分组变量名
})

.data[[.x]]是tidyverse推荐的动态变量引用方式，能解决字符串变量无法正确映射的问题。

解决方案2：移除图例中的额外项 #

大数据集绘图时图例出现不存在的水平，是因为ggplot默认保留因子的所有水平。可以通过两种方式解决：

方法1：在颜色刻度中设置drop=TRUE #

直接在图层中添加刻度设置，自动过滤未使用的水平：

plots <- map2(group_vars, plot_titles, ~{
  ggplot(df, aes(sample = value, color = .data[[.x]])) +
    gglayers +
    ggtitle(.y) +
    labs(color = .x) +
    scale_color_discrete(drop = TRUE) # 关键：移除无数据的水平
})

方法2：提前清理数据的空水平 #

如果数据中存在大量未使用的因子水平，建议先处理数据：

plots <- map2(group_vars, plot_titles, ~{
  # 过滤空值并移除未使用的因子水平
  df_clean <- df %>%
    filter(!is.na(.data[[.x]])) %>%
    mutate(!!.x := fct_drop(.data[[.x]]))
  
  ggplot(df_clean, aes(sample = value, color = .data[[.x]])) +
    gglayers +
    ggtitle(.y) +
    labs(color = .x) +
    scale_color_discrete(drop = TRUE)
})

完整可运行代码 #

整合所有修复后的代码，可直接运行：

library(tidyverse)

# 模拟带空水平的大数据集
set.seed(123)
df <- tibble(
  value = rnorm(10000),
  group1 = sample(c("A", "B", "C", "D"), 10000, replace = TRUE, prob = c(0.4, 0.3, 0.2, 0.1)),
  group2 = sample(c("X", "Y"), 10000, replace = TRUE),
  group3 = sample(c("Low", "Medium", "High", "Extreme"), 10000, replace = TRUE, prob = c(0.5, 0.3, 0.15, 0.05)),
  group4 = sample(c("Yes", "No"), 10000, replace = TRUE)
) %>%
  # 手动制造空水平场景
  filter(!(group1 == "D" & value > 0)) %>%
  filter(!(group3 == "Extreme" & value < -1))

# 复用图层
gglayers <- list(
  geom_point(alpha = 0.6),
  stat_qq_line(color = "red", size = 1),
  theme_minimal(),
  labs(x = "理论分位数", y = "样本分位数")
)

# 分组变量与标题
group_vars <- c("group1", "group2", "group3", "group4")
plot_titles <- paste("按", group_vars, "分组的QQ图")

# 批量绘图（解决两个问题）
plots <- map2(group_vars, plot_titles, ~{
  df_clean <- df %>%
    mutate(!!.x := fct_drop(.data[[.x]]))
  
  ggplot(df_clean, aes(sample = value, color = .data[[.x]])) +
    gglayers +
    ggtitle(.y) +
    labs(color = .x) +
    scale_color_discrete(drop = TRUE)
})

# 查看第一个分组的QQ图
plots[[1]]

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