在图上添加回归线方程和R ^ 2


227

我想知道如何在上添加回归线方程和R ^ 2 ggplot。我的代码是:

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

任何帮助将不胜感激。


1
有关点阵图形,请参见latticeExtra::lmlineq()
乔什·奥布莱恩

Answers:


234

这是一个解决方案

# 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)

编辑。我从选择此代码的地方找出了源。这是ggplot2 Google网上论坛中原始帖子的链接

输出量


1
@JonasRaedle关于获得更好看的文字的评论annotate在我的机器上是正确的。
IRTFM

2
这看起来不像我机器上的已发布输出,在该输出上,标签被覆盖了与调用数据一样多的次数,从而导致标签文本粗大而模糊。通过标签的data.frame第一部作品(见下文评论我的建议。
PatrickT

@PatrickT:删除aes()aes是用于将数据帧变量映射到可视变量的,这里不需要,因为只有一个实例,因此可以将其全部放入主geom_text调用中。我将其编辑为答案。
naught101

该解决方案的问题似乎在于,如果数据集更大(我的数据集为370000个观测值),该函数似乎将失败。我会推荐来自@kdauria的解决方案,它的作用相同,但速度要快得多。
本杰明

3
对于那些想要r和p值而不是R2和等式的人:eq <-replace(italic(r)〜“ =”〜rvalue *“,”〜italic(p)〜“ =”〜pvalue,list(rvalue = sprintf (“%.2f”,sign(coef(m)[2])* sqrt(summary(m)$ r.squared)),pvalue = format(summary(m)$ coefficients [2,4],数字= 2 )))
Jerry T

135

stat_poly_eq()在包装ggpmisc中包含了一个统计信息,可以得出以下答案:

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

在此处输入图片说明

此统计信息可用于任何不缺少项的多项式,并且希望具有足够的灵活性以普遍使用。R ^ 2或调整后的R ^ 2标签可与lm()拟合的任何模型公式一起使用。作为ggplot统计信息,它在组和构面方面的行为均符合预期。

可以通过CRAN获得“ ggpmisc”软件包。

0.2.6版本刚刚被CRAN接受。

它处理@shabbychef和@ MYaseen208的评论。

@ MYaseen208这显示了如何添加帽子

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现在可以将方程式中的变量与轴标签所使用的变量匹配。要更换X有发言权žÿ^ h,应当使用:

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

在此处输入图片说明

通过这些正常的R解析表达式,希腊字母现在也可以在等式的lhs和rhs中使用。

[2017-03-08] @elarry Edit以更精确地解决原始问题,展示如何在方程式标签和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

在此处输入图片说明

[2019-10-20] @ helen.h我在下面给出stat_poly_eq()了分组使用的示例。

library(ggpmisc)
df <- data.frame(x = c(1:100))
df$y <- 20 * c(0, 1) + 3 * df$x + rnorm(100, sd = 40)
df$group <- factor(rep(c("A", "B"), 50))
my.formula <- y ~ x
p <- ggplot(data = df, aes(x = x, y = y, colour = group)) +
  geom_smooth(method = "lm", se=FALSE, formula = my.formula) +
  stat_poly_eq(formula = my.formula, 
               aes(label = paste(..eq.label.., ..rr.label.., sep = "~~~")), 
               parse = TRUE) +         
  geom_point()
p

p <- ggplot(data = df, aes(x = x, y = y, linetype = group)) +
  geom_smooth(method = "lm", se=FALSE, formula = my.formula) +
  stat_poly_eq(formula = my.formula, 
               aes(label = paste(..eq.label.., ..rr.label.., sep = "~~~")), 
               parse = TRUE) +         
  geom_point()
p

在此处输入图片说明

在此处输入图片说明

[2020-01-21] @Herman乍一看可能有点违反直觉,但是在使用分组时要获得一个方程,则需要遵循图形语法。将创建分组的映射限制为单个图层(如下所示),或者保留默认映射,并在不需要分组的层中使用恒定值覆盖它(例如colour = "black")。

继续上一个示例。

p <- ggplot(data = df, aes(x = x, y = y)) +
  geom_smooth(method = "lm", se=FALSE, formula = my.formula) +
  stat_poly_eq(formula = my.formula, 
               aes(label = paste(..eq.label.., ..rr.label.., sep = "~~~")), 
               parse = TRUE) +         
  geom_point(aes(colour = group))
p

在此处输入图片说明

[2020-01-22]为了完整起见,以小平面为例,说明在这种情况下也满足了图形语法的期望。

library(ggpmisc)
df <- data.frame(x = c(1:100))
df$y <- 20 * c(0, 1) + 3 * df$x + rnorm(100, sd = 40)
df$group <- factor(rep(c("A", "B"), 50))
my.formula <- y ~ x

p <- ggplot(data = df, aes(x = x, y = y)) +
  geom_smooth(method = "lm", se=FALSE, formula = my.formula) +
  stat_poly_eq(formula = my.formula, 
               aes(label = paste(..eq.label.., ..rr.label.., sep = "~~~")), 
               parse = TRUE) +         
  geom_point() +
  facet_wrap(~group)
p

在此处输入图片说明


1
应该注意的是 xy式中的参考xy数据中的情节的层,并且不一定在那些在时间范围my.formula被构造。因此,公式应始终使用x和y变量?
shabbychef 2016年

确实,xy提及了映射到这些美学的任何变量。这也是对geom_smooth()以及图形语法如何工作的期望。在数据框中使用不同的名称可能会更清楚,但我只保留了原始问题中的名称。
Pedro Aphalo '16

在下一版本的中将可能ggpmisc。谢谢你的建议!
Pedro Aphalo '16

3
好点@elarry!这与R的parse()函数的工作方式有关。通过反复试验,我发现可以aes(label = paste(..eq.label.., ..rr.label.., sep = "*plain(\",\")~"))完成这项工作。
Pedro Aphalo'4-4-8

1
@HermanToothrot通常,R2是回归的首选,因此在返回的数据中没有预定义的r.label stat_poly_eq()。您也可以使用stat_fit_glance()ggpmisc软件包中的,该软件包将R2作为数值返回。请参阅帮助页面中的示例,并替换stat(r.squared)sqrt(stat(r.squared))
Pedro Aphalo

99

我更改了stat_smooth函数源和相关函数的几行,以创建一个新函数,该函数添加了拟合方程和R平方值。这也适用于多面图!

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)

在此处输入图片说明

我使用@Ramnath答案中的代码来格式化方程式。该stat_smooth_func功能不是很强大,但是使用它应该不难。

https://gist.github.com/kdauria/524eade46135f6348140ggplot2如果遇到错误,请尝试更新。


2
非常感谢。这不仅适用于方面,甚至适用于团体。我发现它对分段回归非常有用,例如stat_smooth_func(mapping=aes(group=cut(x.val,c(-70,-20,0,20,50,130))),geom="text",method="lm",hjust=0,parse=TRUE),与来自stackoverflow.com/questions/19735149/的
朱利安

1
@aelwan,根据需要更改以下行:gist.github.com/kdauria/…。然后source将整个文件放入您的脚本中。
kdauria

1
@kdauria如果每个facet_wraps中都有多个方程并且每个facet_wrap中都有不同的y_value,该怎么办。有什么建议如何确定方程式的位置吗?我使用此示例dropbox.com/s/9lk9lug2nwgno2l/R2_facet_wrap.docx?dl=0尝试了水平,垂直和角度几个选项,但我无法将所有方程式都置于每个facet_wrap的同一水平上
闪亮的

3
@aelwan,方程式的位置由以下行决定:gist.github.com/kdauria/…。我做xposypos在主旨的函数的参数。因此,如果您希望所有方程重叠,只需设置xpos和即可ypos。否则,xpos并且ypos从数据计算。如果您想要更高级的东西,在函数内添加一些逻辑应该不难。例如,也许您可​​以编写一个函数来确定图的哪个部分具有最大的空白空间,然后将该函数放在此处。
kdauria '16

6
我在使用source_gist时遇到了一个错误:r_files [[which]]中的错误:下标类型为'closure'无效。解决方案请参阅此帖子:stackoverflow.com/questions/38345894/r-source-gist-not-working
Matifou

73

我已将Ramnath的帖子修改为:a)使通用性更高,因此它接受线性模型作为参数而不是数据框,并且b)更适当地显示负数。

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

用法将变为:

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

17
看起来很棒!但是我在多个构面上绘制了geom_points,其中df基于facet变量而有所不同。我怎么做?
bshor 2012年

24
Jayden的解决方案效果很好,但是字体看起来非常难看。我建议将用法更改为:p1 = p + annotate("text", x = 25, y = 300, label = lm_eqn(lm(y ~ x, df)), colour="black", size = 5, parse=TRUE)edit:这也可以解决图例中显示的字母可能遇到的任何问题。
乔纳斯·雷德尔

1
@ Jonas,出于某种原因,我得到了"cannot coerce class "lm" to a data.frame"。此替代方法有效:df.labs <- data.frame(x = 25, y = 300, label = lm_eqn(df))p <- p + geom_text(data = df.labs, aes(x = x, y = y, label = label), parse = TRUE)
PatrickT 2014年

1
@PatrickT-这是如果您lm_eqn(lm(...))使用Ramnath的解决方案打电话给您的错误消息。您可能在尝试过一个之后就尝试了,但是忘记了确保重新定义lm_eqn
Hamy 2014年

@PatrickT:您能单独回答吗?我很乐意投票!
JelenaČuklina

11

真的很喜欢@Ramnath解决方案。为了允许使用自定义回归公式(而不是将y和x固定为文字变量名称)并将p值也添加到打印输出中(如@Jerry T所评论),以下是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')

在此处输入图片说明 不幸的是,这不适用于facet_wrap或facet_grid。


非常简洁,我在这里引用。澄清-您的代码ggplot(mtcars, aes(x = wt, y = mpg, group=cyl))+在geom_point()之前丢失了吗?一个半相关的问题-如果我们在ggplot中引用hpwt,那么我们是否aes()可以抓住它们以在to的调用中使用lm_eqn,那么我们只需要在一个地方进行编码?我知道我们可以xvar = "hp"在ggplot()调用之前进行设置,并在两个位置都使用xvar替换hp,但这似乎应该没有必要。
Mark Neal

9

使用ggpubr

library(ggpubr)

# reproducible data
set.seed(1)
df <- data.frame(x = c(1:100))
df$y <- 2 + 3 * df$x + rnorm(100, sd = 40)

# By default showing Pearson R
ggscatter(df, x = "x", y = "y", add = "reg.line") +
  stat_cor(label.y = 300) +
  stat_regline_equation(label.y = 280)

在此处输入图片说明

# Use R2 instead of R
ggscatter(df, x = "x", y = "y", add = "reg.line") +
  stat_cor(label.y = 300, 
           aes(label = paste(..rr.label.., ..p.label.., sep = "~`,`~"))) +
  stat_regline_equation(label.y = 280)

## compare R2 with accepted answer
# m <- lm(y ~ x, df)
# round(summary(m)$r.squared, 2)
# [1] 0.85

在此处输入图片说明


您是否看到了一种简洁的编程方式来指定数字label.y
Mark Neal

@MarkNeal可能得到y的最大值,然后乘以0.8。label.y = max(df$y) * 0.8
zx8754

1
@MarkNeal好点,也许可以在GitHub ggpubr上将问题作为功能请求提交。
zx8754


1
@ zx8754,在您的绘图中显示的是rho而不是R²,有任何简单的显示R²的方法吗?
matmar

5

这是每个人最简单的代码

注意:显示皮尔逊的Rho而不是 R ^ 2。

library(ggplot2)
library(ggpubr)

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()+
        stat_cor(label.y = 35)+ #this means at 35th unit in the y axis, the r squared and p value will be shown
        stat_regline_equation(label.y = 30) #this means at 30th unit regresion line equation will be shown

p

我自己的数据集的一个这样的例子


与上述相同的问题,在您的绘图中显示为rho而不是R²!
matmar

3

受此答案提供的方程式风格的启发,一种更通用的方法(多个预测器+乳胶输出作为选项)可以是:

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

所述model参数期望一个lm对象,所述latex参数是一个布尔值到要求一个简单的字符或乳胶格式化方程和...参数传递其值提供给format功能。

我还添加了一个将其输出为乳胶的选项,因此您可以在rmarkdown中使用此功能,如下所示:


```{r echo=FALSE, results='asis'}
print_equation(model = lm_mod, latex = TRUE)
```

现在使用它:

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)

此代码产生: y = 11.3382963933174 + 2.5893419 * x + 0.1002227 * z

如果我们需要一个乳胶方程式,则将参数四舍五入为3位数字:

print_equation(model = lm_mod, latex = TRUE, digits= 3)

这样产生: 乳胶方程


0

我有一个疑问,如何将t.test的重要统计数据放在等式中,使用 ggpmisc::stat_poly_eq()

例如: expression(hat(Y)== 0000*"**"+0000*"x"*"*"-0000*"x"^2*"**"~~~~"R"^2*":"~~0.000)

By using our site, you acknowledge that you have read and understand our Cookie Policy and Privacy Policy.
Licensed under cc by-sa 3.0 with attribution required.