如何在带随机效应与facet_wrap的ggplot回归图中添加统计结果

这是此前问题的延续，基于sleepstudy的lme4教程展开。

核心问题 #

• 用ggplot绘制带随机效应的回归图并结合facet_wrap，为每个个体的回归（而非整体数据的回归）展示调整R²（r2.adj）和p值（pval）
• 通过annotation_custom()实现统计信息换行显示（回归方程、调整R²、p值各占一行），固定在图的左上角，同时支持调整字号

原始代码 #

library(lme4)
library(ggplot2)
library(grid)
library(ggpmisc)
library(scales)
library(performance)
library(car)

str(sleepstudy)
data("sleepstudy")

ggplot.model.labels  <- function (model.num, df) {

  datafit = fitted(model.num)
  r2 <- round(performance::r2_nakagawa(model.num)$R2_conditional, 3)
  pval <-  scales::pvalue(car::Anova(model.num, test = "F")$`Pr(>F)`, add_p = TRUE)
  ggplot(df, aes(Days, Reaction, group=Subject, colour=Subject)) +
    geom_point() +
    geom_line(aes(y=datafit), linetype=1) +
    annotation_custom(grid::textGrob(
      bquote(bold(~y == 
                    .(round(fixef(model.num)[1], 3)) + .(round(fixef(model.num)[2], 3)) * x) ~
               ~~~italic(paste(.(pval))~~~R^2 == .(r2))),
      x = 0.05, y = 0.9, hjust = 0, gp = gpar(col = "black", fontsize = 5))) +
    
    facet_wrap(~Subject, ncol=9) +
    scale_x_continuous(limits=c(0, 10),breaks=c(0,10)) +
    theme_minimal()
}

model4 <- lmer(Reaction ~ 1 + Days + (1 + Days | Subject), sleepstudy)
ggplot.model.labels (model4, sleepstudy)

原始效果图：

解决方案 #

关键调整点 #

1. 个体统计量计算：放弃整体混合效应模型的结果，改为按Subject分组拟合个体线性回归，才能得到每个个体专属的调整R²和p值
2. 换行与排版：用geom_text替代annotation_custom（更适配分面场景），通过paste0拼接带\n的字符串实现换行，结合parse=TRUE支持格式语法
3. 字号与位置：通过size参数直接调整字号，用分组后的响应变量最大值定位文本位置，避免遮挡数据点

修改后的代码 #

library(lme4)
library(ggplot2)
library(scales)
library(dplyr)

# 加载并预处理数据，按Subject分组计算个体回归统计量
data("sleepstudy")
sleepstudy_stats <- sleepstudy %>%
  group_by(Subject) %>%
  group_modify(~{
    # 拟合个体线性回归模型
    indiv_model <- lm(Reaction ~ Days, data = .x)
    # 提取回归系数
    intercept <- round(coef(indiv_model)[1], 3)
    slope <- round(coef(indiv_model)[2], 3)
    # 计算调整R²
    r2_adj <- round(summary(indiv_model)$adj.r.squared, 3)
    # 提取p值并格式化
    p_val <- scales::pvalue(summary(indiv_model)$coefficients[2, 4], add_p = TRUE)
    # 生成拟合值
    .x$fitted_val <- fitted(indiv_model)
    # 返回包含统计量的数据集
    tibble(.x, intercept, slope, r2_adj, p_val)
  }) %>%
  ungroup()

# 绘制分面回归图
ggplot(sleepstudy_stats, aes(Days, Reaction, group = Subject, colour = Subject)) +
  geom_point() +
  geom_line(aes(y = fitted_val), linetype = 1) +
  # 添加分面专属统计注释
  geom_text(
    aes(
      x = 0.5, y = max(Reaction) - 15,
      label = paste0(
        "bold(y == ", intercept, " + ", slope, "*x)\n",
        "italic(调整R^2 == ", r2_adj, ")\n",
        "italic(", p_val, ")"
      )
    ),
    hjust = 0, size = 4, parse = TRUE, colour = "black", inherit.aes = FALSE
  ) +
  facet_wrap(~Subject, ncol = 9) +
  scale_x_continuous(limits = c(0, 10), breaks = c(0, 10)) +
  theme_minimal()

效果说明 #

• 每个分面独立显示对应个体的回归方程、调整R²和p值，三者自动换行
• 统计信息固定在分面左上角，位置可通过x和y参数微调
• size=4可按需修改，字号调整直接生效

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