Annotate ggplot2 with regression equation and r squared

tidyverse
4

The ggpmisc package looks interesting and probably does what you want.

Nevertheless, to my knowledge the ggplot2 function geom_smooth() returns predictions from the model, but not the model object itself. So getting the r squared, slope and intercept out from that isn't going to work.

Similar to your links I have seen people call a lm() function and then pass the values in. For example, Susan Johnston has this ggplotRegression function which is quite nice which I'll reproduce here. It works fine for single graphs:

ggplotRegression <- function(fit){

require(ggplot2)

ggplot(fit$model, aes_string(x = names(fit$model)[2], y = names(fit$model)[1])) + 
  geom_point() +
  stat_smooth(method = "lm", col = "red") +
  labs(title = paste("Adj R2 = ",signif(summary(fit)$adj.r.squared, 5),
                     "Intercept =",signif(fit$coef[[1]],5 ),
                     " Slope =",signif(fit$coef[[2]], 5),
                     " P =",signif(summary(fit)$coef[2,4], 5)))
}

ggplotRegression(lm(Sepal.Length ~ Petal.Width, data = iris))

To do this for facets you could do something like this:

mpg %>% 
  nest(-drv) %>% 
  mutate(model = map(data, ~ lm(hwy~displ, data = .x)),
         adj.r.squared = map_dbl(model, ~ signif(summary(.x)$adj.r.squared, 5)),
         intercept = map_dbl(model, ~ signif(.x$coef[[1]],5)),
         slope = map_dbl(model, ~ signif(.x$coef[[2]], 5)),
         pvalue = map_dbl(model, ~ signif(summary(.x)$coef[2,4], 5)) 
         ) %>% 
  select(-data, -model) %>% 
  left_join(mpg) %>% 
  
  ggplot(aes(displ, hwy)) +
  geom_point() +
  geom_smooth(se = FALSE, method = "lm") +
  facet_wrap(~drv) +
  geom_text(aes(3, 40, label = paste("Adj R2 = ", adj.r.squared, "\n",
                                   "Intercept =",intercept, "\n",
                                   "Slope =", slope, "\n",
                                   "P =", pvalue)))

But you have to manually adjust position etc. I'm sure this could be generalised.

1 Like