Добавление уравнения линии регрессии и R2 на графике

Я изменил несколько строк источника stat_smooth и связанных функций, чтобы создать новую функцию, которая добавляет уравнение соответствия и квадратичное значение R. Это также будет работать на графических сюжетах!

library(devtools)
source_gist("524eade46135f6348140")
df = data.frame(x = c(1:100))
df$y = 2 + 5 * df$x + rnorm(100, sd = 40)
df$class = rep(1:2,50)
ggplot(data = df, aes(x = x, y = y, label=y)) +
  stat_smooth_func(geom="text",method="lm",hjust=0,parse=TRUE) +
  geom_smooth(method="lm",se=FALSE) +
  geom_point() + facet_wrap(~class)

Я использовал код в ответ @Ramnath для форматирования уравнения. Функция stat_smooth_func не очень надежна, но с ней не должно быть трудно играть.

https://gist.github.com/kdauria/524eade46135f6348140. Попробуйте обновить ggplot2, если вы получите сообщение об ошибке.

Я изменил сообщение Ramnath на a) сделать более общий, поэтому он принимает линейную модель как параметр, а не кадр данных, и б) более негативно отображает негативы.

lm_eqn = function(m) {

  l <- list(a = format(coef(m)[1], digits = 2),
      b = format(abs(coef(m)[2]), digits = 2),
      r2 = format(summary(m)$r.squared, digits = 3));

  if (coef(m)[2] >= 0)  {
    eq <- substitute(italic(y) == a + b %.% italic(x)*","~~italic(r)^2~"="~r2,l)
  } else {
    eq <- substitute(italic(y) == a - b %.% italic(x)*","~~italic(r)^2~"="~r2,l)    
  }

  as.character(as.expression(eq));                 
}

Использование изменилось бы на:

p1 = p + geom_text(aes(x = 25, y = 300, label = lm_eqn(lm(y ~ x, df))), parse = TRUE)

Я включил статистику stat_poly_eq() в моем пакете ggpmisc который позволяет этот ответ:

library(ggplot2)
library(ggpmisc)
df <- data.frame(x = c(1:100))
df$y <- 2 + 3 * df$x + rnorm(100, sd = 40)
my.formula <- y ~ x
p <- ggplot(data = df, aes(x = x, y = y)) +
   geom_smooth(method = "lm", se=FALSE, color="black", formula = my.formula) +
   stat_poly_eq(formula = my.formula, 
                aes(label = paste(..eq.label.., ..rr.label.., sep = "~~~")), 
                parse = TRUE) +         
   geom_point()
p

Эта статистика работает с любым полиномом без отсутствующих терминов и, мы надеемся, обладает достаточной гибкостью, чтобы быть в целом полезной. R ^ 2 или скорректированные метки R ^ 2 могут использоваться с любой модельной формулой, снабженной lm(). Будучи статистикой ggplot, она ведет себя как ожидалось как с группами, так и с фасетками.

Пакет 'ggpmisc' доступен через CRAN.

Версия 0.2.6 была просто принята в CRAN.

Он обращается к комментариям @shabbychef и @MYaseen208.

@MYaseen208 показывает, как добавить шляпу.

library(ggplot2)
library(ggpmisc)
df <- data.frame(x = c(1:100))
df$y <- 2 + 3 * df$x + rnorm(100, sd = 40)
my.formula <- y ~ x
p <- ggplot(data = df, aes(x = x, y = y)) +
   geom_smooth(method = "lm", se=FALSE, color="black", formula = my.formula) +
   stat_poly_eq(formula = my.formula,
                eq.with.lhs = "italic(hat(y))~'='~",
                aes(label = paste(..eq.label.., ..rr.label.., sep = "~~~")), 
                parse = TRUE) +         
   geom_point()
p

@shabbychef Теперь можно сопоставить переменные в уравнении с теми, которые используются для меток оси. Чтобы заменить x с помощью z и y на h, вы должны использовать:

p <- ggplot(data = df, aes(x = x, y = y)) +
   geom_smooth(method = "lm", se=FALSE, color="black", formula = my.formula) +
   stat_poly_eq(formula = my.formula,
                eq.with.lhs = "italic(h)~'='~",
                eq.x.rhs = "~italic(z)",
                aes(label = ..eq.label..), 
                parse = TRUE) + 
   labs(x = expression(italic(z)), y = expression(italic(h))) +          
   geom_point()
p

Будучи этими нормальными R-выражениями, греческие буквы теперь могут также использоваться как в lhs, так и в rhs уравнения.

[2017-03-08] @elarry Изменить, чтобы более точно задать исходный вопрос, показывая, как добавить запятую между equation- и R2-метками.

p <- ggplot(data = df, aes(x = x, y = y)) +
  geom_smooth(method = "lm", se=FALSE, color="black", formula = my.formula) +
  stat_poly_eq(formula = my.formula,
               eq.with.lhs = "italic(hat(y))~'='~",
               aes(label = paste(..eq.label.., ..rr.label.., sep = "*plain(\",\")~")), 
               parse = TRUE) +         
  geom_point()
p