Agregar la ecuación de línea de regresión y R2 en el gráfico

Me pregunto cómo agregar la ecuación de línea de regresión y R ^ 2 en ggplot . Mi código es

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

Cualquier ayuda será muy apreciada.

Aquí hay una solución

 # GET EQUATION AND R-SQUARED AS STRING # SOURCE: http://goo.gl/K4yh lm_eqn <- function(df){ m <- lm(y ~ x, df); eq <- substitute(italic(y) == a + b %.% italic(x)*","~~italic(r)^2~"="~r2, list(a = format(coef(m)[1], digits = 2), b = format(coef(m)[2], digits = 2), r2 = format(summary(m)$r.squared, digits = 3))) as.character(as.expression(eq)); } p1 <- p + geom_text(x = 25, y = 300, label = lm_eqn(df), parse = TRUE) 

EDITAR. Calculé la fuente desde donde elegí este código. Aquí está el enlace a la publicación original en los grupos de ggplot2 google

Salida

Cambié algunas líneas de la fuente de stat_smooth y funciones relacionadas para crear una nueva función que agrega la ecuación de ajuste y el valor de R cuadrado. ¡Esto también funcionará en los diagtwigs de facetas!

 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) 

enter image description here

Usé el código en la respuesta de @Ramnath para formatear la ecuación. La función stat_smooth_func no es muy robusta, pero no debería ser difícil jugar con ella.

https://gist.github.com/kdauria/524eade46135f6348140 . Intenta actualizar ggplot2 si obtienes un error.

Modifiqué la publicación de Ramnath para que a) sea más genérica, por lo que acepta un modelo lineal como parámetro en lugar de dataframe yb) muestra los aspectos negativos de manera más adecuada.

 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)); } 

El uso cambiaría a:

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

stat_poly_eq() una estadística stat_poly_eq() en mi paquete ggpmisc que permite esta respuesta:

 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 

enter image description here

Esta estadística funciona con cualquier polinomio sin términos faltantes, y con suerte tiene suficiente flexibilidad para ser útil en general. Las tags R ^ 2 o R ^ 2 ajustadas se pueden usar con cualquier fórmula modelo equipada con lm (). Al ser una estadística de ggplot, se comporta como se esperaba tanto con grupos como con facetas.

El paquete 'ggpmisc' está disponible a través de CRAN.

La versión 0.2.6 acaba de ser aceptada por CRAN.

Aborda los comentarios de @shabbychef y @ MYaseen208.

@ MYaseen208 esto muestra cómo agregar un sombrero .

 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 

enter image description here

@shabbychef Ahora es posible hacer coincidir las variables en la ecuación con las usadas para las tags de eje. Para reemplazar la x con decir z e y con h uno usaría:

 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 

enter image description here

Siendo estas expresiones R analizadas normales, las letras griegas ahora también se pueden usar tanto en lhs como en rhs de la ecuación.

[2017-03-08] @elarry Editar para abordar con mayor precisión la pregunta original, que muestra cómo agregar una coma entre las tags de ecuación y 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 

enter image description here

Realmente amo la solución @Ramnath. Para permitir el uso para personalizar la fórmula de regresión (en lugar de fijarse como yyx como nombres de variables literales), y también se agregó el valor p en la impresión (como comentó @Jerry T), aquí está el mod:

 lm_eqn <- function(df, y, x){ formula = as.formula(sprintf('%s ~ %s', y, x)) m <- lm(formula, data=df); # formating the values into a summary string to print out # ~ give some space, but equal size and comma need to be quoted eq <- substitute(italic(target) == a + b %.% italic(input)*","~~italic(r)^2~"="~r2*","~~p~"="~italic(pvalue), list(target = y, input = x, a = format(as.vector(coef(m)[1]), digits = 2), b = format(as.vector(coef(m)[2]), digits = 2), r2 = format(summary(m)$r.squared, digits = 3), # getting the pvalue is painful pvalue = format(summary(m)$coefficients[2,'Pr(>|t|)'], digits=1) ) ) as.character(as.expression(eq)); } geom_point() + ggrepel::geom_text_repel(label=rownames(mtcars)) + geom_text(x=3,y=300,label=lm_eqn(mtcars, 'hp','wt'),color='red',parse=T) + geom_smooth(method='lm') 

enter image description here Lamentablemente, esto no funciona con facet_wrap o facet_grid.