如何在tidyverse框架下分组求解多项式模型最优x值

核心思路 #

利用tidyverse的分组嵌套+函数映射机制，实现多组数据的批量处理：

1. 按分组变量拆分数据并嵌套为列表列
2. 对每组数据拟合二次多项式模型
3. 提取模型系数，通过二次函数顶点公式计算y取最大值时的x值
4. 批量生成分组可视化图表

完整实现代码 #

library(tidyverse)

# 示例数据
df <- data.frame(
  Group = rep(c("A", "B"), each = 12),
  price = c(448, 560, 575, 500, 612, 600, 610, 590, 589, 532, 577, 560,
            454, 568, 584, 506, 617, 608, 617, 599, 598, 537, 583, 567),
  score = c(83, 86, 89, 85, 89, 90, 91, 91, 91, 85, 88, 93,
            89, 94, 98, 91, 94, 98, 98, 100, 100, 90, 94, 100)
)

# 1. 分组拟合模型并计算最优x值
group_results <- df %>%
  group_by(Group) %>%
  nest() %>% # 将每组数据嵌套为列表列，方便批量处理
  mutate(
    # 对每组数据拟合二次多项式模型
    model = map(data, ~ lm(price ~ score + I(score^2), data = .x)),
    # 提取模型系数
    coeffs = map(model, coef),
    # 用二次函数顶点公式计算最优x值：x = -b/(2a)，a为score^2的系数，b为score的系数
    x_optimum = map_dbl(coeffs, ~ -.[[2]] / (2 * .[[3]]))
  ) %>%
  # 展开数据，保留分组、最优值和原始观测
  unnest(cols = data) %>%
  select(Group, x_optimum, score, price)

# 查看每组的最优x值
group_results %>%
  distinct(Group, x_optimum)

# 2. 批量生成分组可视化图表
ggplot(group_results, aes(x = score, y = price)) +
  geom_point(size = 2, alpha = 0.7) +
  # 添加拟合的二次多项式曲线
  geom_smooth(method = "lm", formula = y ~ x + I(x^2), color = "blue", se = FALSE) +
  # 添加最优x值的垂直线
  geom_vline(aes(xintercept = x_optimum), color = "red", linetype = "dashed") +
  facet_wrap(~ Group) + # 按分组分面展示
  labs(x = "Score", y = "Price") +
  theme_bw()

关键代码解释 #

• nest()：把每组数据打包成列表列，避免循环操作，适配tidyverse的批量处理逻辑
• map()：对嵌套的每组数据批量应用模型拟合函数，实现多组数据的一次性建模
• map_dbl()：提取系数并计算最优x值，返回数值型结果，方便后续分析
• facet_wrap()：一键生成所有分组的可视化图表，同时展示散点、拟合曲线和最优值标记

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