R语言实现多组PM数据与POPs的回归分析并合并绘图

问题背景 #

• 数据：POPs为长度3000的数值型向量，PM1、PM2等多组数据也均为长度3000的数值型向量
• 需求：对每组PM数据与POPs进行回归分析，将所有回归图合并到一个画布，同时添加R²、RMSE、MAE、回归线及1:1线
• 初始困境：仅能单独绘制单组PM的回归图，无法通过批量处理实现多图合并

初始单图代码 #

ggplot(data = Plot, aes(x=POPs, y=PM1)) +
  stat_smooth(method = "lm", se=FALSE, color="black", formula = y ~ x) +
  geom_point(size=0.3) +
  stat_cor(aes(label = paste(..rr.label..)), # 添加R²值
           r.accuracy = 0.01,
           label.x = 0, label.y = 375, size = 4) +
  stat_regline_equation(aes(label = ..eq.label..), # 添加线性回归方程
                        label.x = 0, label.y = 400, size = 4)

最终批量合并代码 #

通过数据长格式转换+分面绘图实现批量需求，完美达成多图合并及指标添加：

# 将宽格式数据转换为长格式
Plot %>%  
  pivot_longer(cols=starts_with("PEM"), names_to = "PEMs", values_to = "PEMs_value") -> df2

df2 %>% ggplot(aes(POPs, PEMs_value)) +
  geom_point(color = "#fe4300", size=0.3) +
  geom_abline() + # 添加1:1参考线
  geom_smooth(method='lm', se=FALSE, formula = y ~ x, color = "#1b14fd") + # 添加线性回归线
  labs(y = expression(bold(PLF~PM["2.5"]~("μ"*g/m^"3"))), x = expression(bold(POPS~PM["2.5"]~("μ"*g/m^"3")))) +
  stat_cor(aes(label = paste(..rr.label..)), # 添加R²值
           r.accuracy = 0.01,
           label.x = 0, label.y = 110, size = 3) +
  stat_regline_equation(aes(label = ..eq.label..), # 添加线性回归方程
                        label.x = 0, label.y = 100, size = 3) +
  facet_wrap(~PEMs, ncol=5) # 按PM分组分面，每行展示5张图

补充：添加RMSE、MAE指标 #

若需在图中显示RMSE和MAE，可先分组计算指标，再通过geom_text添加到对应子图：

# 分组计算RMSE、MAE
metrics <- df2 %>%
  group_by(PEMs) %>%
  summarise(
    rmse = sqrt(mean((PEMs_value - predict(lm(PEMs_value ~ POPs, data = cur_data()), cur_data()))^2)),
    mae = mean(abs(PEMs_value - predict(lm(PEMs_value ~ POPs, data = cur_data()), cur_data())))
  ) %>%
  mutate(label = paste0("RMSE: ", round(rmse, 2), "\nMAE: ", round(mae, 2)))

# 整合指标到绘图代码
df2 %>% ggplot(aes(POPs, PEMs_value)) +
  # 保留原有所有图层...
  geom_text(data = metrics, aes(x = 0, y = 90, label = label), size = 3) +
  facet_wrap(~PEMs, ncol=5)

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