如何批量提取多条拟合直线的斜率与截距并汇总为tibble？

不要从stat_poly_eq渲染的图面方程文本反向解析参数，这种方式容易因文本格式、有效数字设置出现解析错误，处理50+分组时稳定性很差。最简便且100%匹配绘图结果的方式是直接按绘图的分组逻辑在数据层批量拟合模型，直接提取系数。

实现代码 #

运行以下代码可以直接得到你需要的包含cyl、gear、slope、intercept列的tibble对象，拟合逻辑和你现有绘图代码的拟合规则完全一致：

library(tidyverse)
library(ggpmisc)

# 批量拟合提取系数
lm_coef_tbl <- mtcars %>%
  # 对齐绘图分组规则：分面变量gear、颜色映射变量cyl
  group_by(cyl, gear) %>%
  group_modify(~{
    # 每组构建和stat_poly_eq一致的一元线性模型
    fit <- lm(mpg ~ wt, data = .x)
    tibble(
      intercept = unname(coef(fit)[1]), # 截距
      slope = unname(coef(fit)[2])      # 斜率
    )
  }) %>%
  ungroup()

# 输出查看结果
print(lm_coef_tbl)

# 原有绘图代码可正常运行，提取的系数和图面展示的方程完全对应
ggplot(mtcars, aes(x = wt, y = mpg, color = as.character(cyl))) +
  geom_point()+
  facet_wrap(gear ~ .) +
  stat_poly_line(fullrange = TRUE, se = FALSE) +
  stat_poly_eq(aes(label = paste(..eq.label.., ..rr.label.., sep = "~~~~~")), 
               parse=TRUE,label.x.npc = "right")

补充说明 #

• 代码里的分组规则完全对齐ggplot的映射逻辑：分面变量gear、颜色分组变量cyl作为分组键，不会出现提取结果和图面方程不匹配的问题。
• 如果需要同步提取图上展示的R²值，只要在tibble()内部新增一行r2 = summary(fit)$r.squared即可，取值和stat_poly_eq展示的结果完全一致。
• 该方法处理上百个分组也能秒级出结果，不需要逐个人工核对图面方程。

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