Dodanie równania linii regresji i R2 na wykresie
Zastanawiam się, jak dodać równanie linii regresji i R^2 na ggplot
. Mój kod to
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
Każda pomoc będzie mile widziana. 5 answers
Oto jedno rozwiązanie
# 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)
EDIT. Rozgryzłem źródło, skąd wybrałem ten kod. Oto link do oryginalnego postu w ggplot2 google groups
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2015-06-18 18:58:43
Zmieniłem kilka linijek Źródła stat_smooth
i powiązanych funkcji, aby stworzyć nową funkcję, która dodaje równanie dopasowania i wartość R do kwadratu. To będzie działać na powierzchniach zbyt!
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)
Użyłem kodu w odpowiedzi @ Ramnath do sformatowania równania. Funkcja stat_smooth_func
nie jest zbyt solidna, ale nie powinno być trudno się nią bawić.
Https://gist.github.com/kdauria/524eade46135f6348140 . spróbuj zaktualizować ggplot2
, Jeśli pojawi się błąd.
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2016-02-21 01:59:01
Zmodyfikowałem post Ramnatha na a) bardziej ogólny, aby akceptował model liniowy jako parametr, a nie ramkę danych i B) wyświetla negatywy bardziej odpowiednio.
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));
}
Użycie zmieni się na:
p1 = p + geom_text(aes(x = 25, y = 300, label = lm_eqn(lm(y ~ x, df))), parse = TRUE)
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2012-12-09 20:14:29
Dodałem statystyki stat_poly_eq()
do mojego pakietu ggpmisc
to pozwala na taką odpowiedź:
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
Ta statystyka działa z dowolnym wielomianem bez brakujących terminów i miejmy nadzieję, że ma wystarczającą elastyczność, aby być ogólnie użytecznym. Etykiety R^2 lub adjusted R^2 mogą być używane z dowolnym wzorem modelu wyposażonym w lm (). Jako statystyka ggplot zachowuje się zgodnie z oczekiwaniami zarówno z grupami, jak i aspektami.
Pakiet "ggpmisc" jest dostępny poprzez CRAN.
Wersja 0.2.6 została właśnie przyjęta do CRAN.
Odnosi się do komentarzy @ shabbychef i @MYaseen208.
@MYaseen208 to pokazuje jak dodać kapelusz .
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 teraz możliwe jest dopasowanie zmiennych w równaniu do tych używanych dla etykiet osi. Aby zastąpić x przez Z i y przez h należy użyć:
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
Bycie te normalne wyrażenia r parsowane mogą być teraz również używane zarówno w LHS, jak i rhs równania.
[2017-03-08] @ elarry Edytuj, aby dokładniej odpowiedzieć na pierwotne pytanie, pokazując, jak dodać przecinek między etykietami równania i 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
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2018-04-17 15:44:43
Really love @ Ramnath solution. Aby umożliwić użycie do dostosowania formuły regresji (zamiast stałej jako y i x jako literalne nazwy zmiennych), a także dodać wartość p do wydruku (jak skomentował @ Jerry T), oto 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')
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2018-08-22 20:38:56