[英]Adding Regression Line Equation and R2 on SEPARATE LINES graph
幾年前,一張海報詢問如何在下面的鏈接中添加回歸線方程和R2在ggplot圖上。
最重要的解決方案是:
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)
我正在使用此代碼,它很有用。 但是,我想知道是否有可能使這段代碼在單獨的行上具有R2值和回歸線方程,而不是用逗號分隔。
而不是像這樣
像這樣的東西
在此先感謝您的幫助!
編輯:
除了插入等式,我還修正了截距值的符號。 通過將RNG設置為set.seed(2L)
將給出正截距。 以下示例產生負截距。
我還修復了geom_text
的重疊文本
set.seed(3L)
library(ggplot2)
df <- data.frame(x = c(1:100))
df$y <- 2 + 3 * df$x + rnorm(100, sd = 40)
lm_eqn <- function(df){
# browser()
m <- lm(y ~ x, df)
a <- coef(m)[1]
a <- ifelse(sign(a) >= 0,
paste0(" + ", format(a, digits = 4)),
paste0(" - ", format(-a, digits = 4)) )
eq1 <- substitute( paste( italic(y) == b, italic(x), a ),
list(a = a,
b = format(coef(m)[2], digits = 4)))
eq2 <- substitute( paste( italic(R)^2 == r2 ),
list(r2 = format(summary(m)$r.squared, digits = 3)))
c( as.character(as.expression(eq1)), as.character(as.expression(eq2)))
}
labels <- lm_eqn(df)
p <- ggplot(data = df, aes(x = x, y = y)) +
geom_smooth(method = "lm", se=FALSE, color="red", formula = y ~ x) +
geom_point() +
geom_text(x = 75, y = 90, label = labels[1], parse = TRUE, check_overlap = TRUE ) +
geom_text(x = 75, y = 70, label = labels[2], parse = TRUE, check_overlap = TRUE )
print(p)
ggpmisc
包具有stat_poly_eq
函數,該函數專門為此任務構建(但不限於線性回歸)。 使用與@Sathish發布的相同的data
,我們可以單獨添加等式和R2,但給label.y.npc
不同的值。 如果需要, label.x.npc
可以調整。
library(ggplot2)
library(ggpmisc)
#> For news about 'ggpmisc', please, see https://www.r4photobiology.info/
set.seed(21318)
df <- data.frame(x = c(1:100))
df$y <- 2 + 3*df$x + rnorm(100, sd = 40)
formula1 <- y ~ x
ggplot(data = df, aes(x = x, y = y)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE, formula = formula1) +
stat_poly_eq(aes(label = paste(..eq.label.., sep = "~~~")),
label.x.npc = "right", label.y.npc = 0.15,
eq.with.lhs = "italic(hat(y))~`=`~",
eq.x.rhs = "~italic(x)",
formula = formula1, parse = TRUE, size = 5) +
stat_poly_eq(aes(label = paste(..rr.label.., sep = "~~~")),
label.x.npc = "right", label.y.npc = "bottom",
formula = formula1, parse = TRUE, size = 5) +
theme_bw(base_size = 16)
# using `atop`
ggplot(data = df, aes(x = x, y = y)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE, formula = formula1) +
stat_poly_eq(aes(label = paste0("atop(", ..eq.label.., ",", ..rr.label.., ")")),
formula = formula1,
parse = TRUE) +
theme_bw(base_size = 16)
### bonus: including result table
ggplot(data = df, aes(x = x, y = y)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE, formula = formula1) +
stat_fit_tb(method = "lm",
method.args = list(formula = formula1),
tb.vars = c(Parameter = "term",
Estimate = "estimate",
"s.e." = "std.error",
"italic(t)" = "statistic",
"italic(P)" = "p.value"),
label.y = "bottom", label.x = "right",
parse = TRUE) +
stat_poly_eq(aes(label = paste0("atop(", ..eq.label.., ",", ..rr.label.., ")")),
formula = formula1,
parse = TRUE) +
theme_bw(base_size = 16)
由reprex包創建(v0.3.0)
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.