Ajout de L'équation de droite de régression et R2 sur le graphique

J'ai changé quelques lignes de la source de stat_smooth et des fonctions connexes pour créer une nouvelle fonction qui ajoute l'équation d'ajustement et la valeur R au carré. Cela fonctionnera sur les parcelles de facette aussi!

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)

J'ai utilisé le code dans la réponse de @Ramnath pour formater l'équation. La fonction stat_smooth_func n'est pas très robuste, mais il ne devrait pas être difficile de jouer avec elle.

Https://gist.github.com/kdauria/524eade46135f6348140 . essayez de mettre à jour ggplot2 Si vous obtenez une erreur.

J'ai modifié le post de Ramnath pour a) rendre plus générique afin qu'il accepte un modèle linéaire en tant que paramètre plutôt que le cadre de données et b) affiche les négatifs de manière plus appropriée.

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

L'utilisation changerait en:

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

J'ai inclus une statistique stat_poly_eq() dans mon colis ggpmisc que permet cette réponse:

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

Cette statistique fonctionne avec n'importe quel polynôme sans Termes manquants, et j'espère avoir assez de flexibilité pour être généralement utile. Les étiquettes R ^ 2 ou R ^ 2 ajustées peuvent être utilisées avec n'importe quelle formule de modèle équipée de lm(). Étant une statistique ggplot, il se comporte comme prévu à la fois avec des groupes et des facettes.

Le paquet 'ggpmisc' est disponible via CRAN.

La Version 0.2.6 vient d'être acceptée par CRAN.

Il répond aux commentaires de @ shabbychef et @ MYaseen208.

@ MYaseen208 ceci montre comment ajouter un chapeau .

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 maintenant, il est possible de faire correspondre les variables de l'équation à celles utilisées pour les étiquettes d'axe. Pour remplacer les x, avec dire z et y avec h on peut utiliser:

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

Être ces expressions normales R analysées lettres grecques peuvent maintenant également être utilisés à la fois dans le lhs et rhs de l'équation.

[2017-03-08] @ elarry Modifier pour répondre plus précisément à la question initiale, montrant comment ajouter une virgule entre les étiquettes d'équation et 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

Vraiment l'amour @Ramnath solution. Pour permettre l'utilisation de personnaliser la formule de régression (au lieu de fixer comme y et x comme noms de variables littérales), et ajouté la valeur p dans l'impression aussi bien (comme @Jerry T a commenté), voici le 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')

Malheureusement, cela ne fonctionne pas avec facet_wrap ou facet_grid.