Ajout de l'équation de ligne de régression et de R2 sur le graphique
Je me demande comment ajouter l'équation de la droite de régression et R ^ 2 sur le ggplot. Mon code est
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
Toute aide sera grandement appréciée.
Voici une solution
# GET EQUATION AND R-SQUARED AS STRING
# SOURCE: https://groups.google.com/forum/#!topic/ggplot2/1TgH-kG5XMA
lm_eqn <- function(df){
m <- lm(y ~ x, df);
eq <- substitute(italic(y) == a + b %.% italic(x)*","~~italic(r)^2~"="~r2,
list(a = format(unname(coef(m)[1]), digits = 2),
b = format(unname(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)
MODIFIER. J'ai compris la source d'où j'ai choisi ce code. Voici le lien vers le message d'origine dans les groupes de Google ggplot2
J'ai inclus une statistique stat_poly_eq() dans mon paquet ggpmisc qui 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 aucun terme manquant, et a heureusement suffisamment de souplesse pour être généralement utile. Les étiquettes R ^ 2 ou R ^ 2 ajustées peuvent être utilisées avec n’importe quelle formule modèle équipée de lm (). En tant que statistique ggplot, il se comporte comme prévu avec des groupes et des facettes.
Le package '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 cela montre comment ajouter un hat .
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 Il est maintenant possible de faire correspondre les variables de l'équation à celles utilisées pour les libellés d'axe. Pour remplacer le x par say z et y avec h on utiliserait:
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
Étant ces expressions R analysées normales, les lettres grecques peuvent désormais être utilisées aussi bien dans les lhs que dans les rhs de l'équation.
[2017-03-08] @elarry Edit pour répondre plus précisément à la question initiale, en montrant comment ajouter une virgule entre les libellés 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
J'ai modifié quelques lignes de la source de stat_smooth et des fonctions associées pour créer une nouvelle fonction qui ajoute l'équation d'ajustement et la valeur R au carré. Cela fonctionnera aussi sur les parcelles à facettes!
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 la jouer.
https://Gist.github.com/kdauria/524eade46135f634814 . Essayez de mettre à jour ggplot2 si vous obtenez une erreur.
J'ai modifié le post de Ramnath en a) rendre plus générique afin qu'il accepte un modèle linéaire en tant que paramètre plutôt que le bloc 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 à:
p1 = p + geom_text(aes(x = 25, y = 300, label = lm_eqn(lm(y ~ x, df))), parse = TRUE)
aime vraiment la solution @Ramnath. Pour permettre à l'utilisateur de personnaliser la formule de régression (au lieu de fixer y et x comme noms de variable littéraux) et d'ajouter également la valeur p à l'impression (comme @Jerry T 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.
Inspirée du style d’équation fourni dans cette réponse , une approche plus générique (plusieurs prédicteurs + sortie latex en option) peut être:
print_equation= function(model, latex= FALSE, ...){
dots <- list(...)
cc= model$coefficients
var_sign= as.character(sign(cc[-1]))%>%gsub("1","",.)%>%gsub("-"," - ",.)
var_sign[var_sign==""]= ' + '
f_args_abs= f_args= dots
f_args$x= cc
f_args_abs$x= abs(cc)
cc_= do.call(format, args= f_args)
cc_abs= do.call(format, args= f_args_abs)
pred_vars=
cc_abs%>%
paste(., x_vars, sep= star)%>%
paste(var_sign,.)%>%paste(., collapse= "")
if(latex){
star= " \\cdot "
y_var= strsplit(as.character(model$call$formula), "~")[[2]]%>%
paste0("\\hat{",.,"_{i}}")
x_vars= names(cc_)[-1]%>%paste0(.,"_{i}")
}else{
star= " * "
y_var= strsplit(as.character(model$call$formula), "~")[[2]]
x_vars= names(cc_)[-1]
}
equ= paste(y_var,"=",cc_[1],pred_vars)
if(latex){
equ= paste0(equ," + \\hat{\\varepsilon_{i}} \\quad where \\quad \\varepsilon \\sim \\mathcal{N}(0,",
summary(MetamodelKdifEryth)$sigma,")")%>%paste0("$",.,"$")
}
cat(equ)
}
L'argument model attend un objet lm, l'argument latex est un booléen pour demander un caractère simple ou une équation au format latex, et l'argument ... transmet ses valeurs. à la fonction format.
J'ai aussi ajouté une option pour le sortir en latex afin que vous puissiez utiliser cette fonction dans un rmarkdown comme ceci:
```{r echo=FALSE, results='asis'}
print_equation(model = lm_mod, latex = TRUE)
```
Maintenant, en l'utilisant:
df <- data.frame(x = c(1:100))
df$y <- 2 + 3 * df$x + rnorm(100, sd = 40)
df$z <- 8 + 3 * df$x + rnorm(100, sd = 40)
lm_mod= lm(y~x+z, data = df)
print_equation(model = lm_mod, latex = FALSE)
Ce code donne: y = 11.3382963933174 + 2.5893419 * x + 0.1002227 * z
Et si nous demandons une équation au latex, arrondir les paramètres à 3 chiffres:
print_equation(model = lm_mod, latex = TRUE, digits= 3)
Cela donne: 