如何在ggplot分面图中为每个分面设置geom_smooth的scam拟合参数

问题根源 #

你用循环添加图层时参数被覆盖，是因为ggplot采用延迟求值机制：图层的参数不会在循环迭代时立即计算，而是在最终渲染图表时才读取变量值。循环结束后facet变量保留最后一个分组的值，导致所有图层都复用了最后一个分组的bs参数。

通用解决思路 #

先按分组预计算每个组对应的bs参数，再通过映射的方式为每个分组生成独立的geom_smooth图层，确保每个图层的参数被独立捕获，不会被后续迭代覆盖。

完整可运行代码 #

library(tidyverse)
library(palmerpenguins)
library(scam)

# 1. 按分组计算每个组的Kendall tau-b系数，确定对应的bs参数
group_params <- penguins %>%
  drop_na(bill_depth_mm, body_mass_g) %>%
  group_by(island) %>%
  summarise(
    tau = cor(bill_depth_mm, body_mass_g, method = "kendall"),
    bs_type = ifelse(tau > 0, "mpi", "mpd"), # mpi=单调递增，mpd=单调递减
    .groups = "drop"
  )

# 2. 构建基础绘图框架
base_plot <- ggplot(penguins, aes(x = bill_depth_mm, y = body_mass_g)) +
  geom_point() +
  theme_bw() +
  labs(x = "Bill Depth (mm)", y = "Body Mass (g)") +
  facet_wrap(~island)

# 3. 为每个分组添加对应的geom_smooth图层
final_plot <- base_plot + pmap(group_params, function(island, tau, bs_type) {
  geom_smooth(
    data = filter(penguins, island == island),
    color = "black",
    method = scam,
    formula = y ~ s(x, bs = bs_type)
  )
})

final_plot

代码说明 #

• 第一步先清理缺失值，按分组计算Kendall tau-b系数，根据符号确定bs参数（mpi对应正相关的单调递增拟合，mpd对应负相关的单调递减拟合）。
• 用purrr::pmap遍历预计算的分组参数列表，为每个分组生成独立的geom_smooth图层，每个图层的参数被单独捕获，避免了循环中的求值延迟问题。
• 这种方式完全通用，只要替换分组变量、x/y变量，就能适配任意数据集。

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