Thêm phương trình đường hồi quy và R ^ 2 trên biểu đồ

Tôi tự hỏi làm thế nào để thêm phương trình đường hồi quy và R ^ 2 trên ggplot . Mã của tôi là:

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

Bất kỳ trợ giúp sẽ được đánh giá cao.

Đây là một giải pháp

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

BIÊN TẬP. Tôi đã tìm ra nguồn từ nơi tôi chọn mã này. Đây là liên kết đến bài viết gốc trong các nhóm google ggplot2

Tôi đã bao gồm một số liệu thống kê stat_poly_eq()trong gói ggpmisccho phép câu trả lời này:

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

Thống kê này hoạt động với bất kỳ đa thức nào không thiếu các thuật ngữ và hy vọng có đủ tính linh hoạt để nói chung là hữu ích. Có thể sử dụng nhãn R ^ 2 hoặc R ^ 2 đã điều chỉnh với bất kỳ công thức mô hình nào được trang bị lm (). Là một thống kê ggplot, nó hoạt động như mong đợi cả với các nhóm và các khía cạnh.

Gói 'ggpmisc' có sẵn thông qua CRAN.

Phiên bản 0.2.6 vừa được chấp nhận cho CRAN.

Nó giải quyết các bình luận của @shabbychef và @ MYaseen208.

@ MYaseen208 điều này cho thấy làm thế nào để thêm một chiếc mũ .

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 Bây giờ có thể khớp các biến trong phương trình với các biến được sử dụng cho nhãn trục. Để thay thế x bằng say z và y bằng h người ta sẽ sử dụng:

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

Là những biểu thức phân tách R bình thường, các chữ cái Hy Lạp bây giờ cũng có thể được sử dụng cả trong lhs và rhs của phương trình.

[2017-03-08] @elarry Chỉnh sửa để giải quyết chính xác hơn câu hỏi ban đầu, cho biết cách thêm dấu phẩy giữa phương trình và nhãn 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 Tôi đưa ra các ví dụ dưới đây về việc sử dụng stat_poly_eq()với nhóm.

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 Có thể hơi phản trực giác ngay từ cái nhìn đầu tiên, nhưng để có được một phương trình duy nhất khi sử dụng nhóm, người ta cần tuân theo ngữ pháp của đồ họa. Hoặc hạn chế ánh xạ tạo nhóm thành các lớp riêng lẻ (hiển thị bên dưới) hoặc giữ ánh xạ mặc định và ghi đè lên nó bằng một giá trị không đổi trong lớp mà bạn không muốn nhóm (ví dụ:colour = "black" ).

Tiếp tục từ ví dụ trước.

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] Để hoàn thiện một ví dụ với các khía cạnh, chứng tỏ rằng trong trường hợp này, những kỳ vọng về ngữ pháp của đồ họa được đáp ứng.

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

Tôi đã thay đổi một vài dòng của nguồn stat_smoothvà các hàm liên quan để tạo ra một hàm mới có thêm phương trình phù hợp và giá trị bình phương R. Điều này sẽ làm việc trên các lô khía cạnh quá!

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)

Tôi đã sử dụng mã trong câu trả lời của @ Ramnath để định dạng phương trình. Các stat_smooth_funcchức năng không phải là rất mạnh mẽ, nhưng nó không phải là khó khăn để chơi đùa với nó.

https://gist.github.com/kdauria/524eade46135f6348140 . Hãy thử cập nhật ggplot2nếu bạn gặp lỗi.

Tôi đã sửa đổi bài đăng của Ramnath thành a) tạo ra chung chung hơn để nó chấp nhận mô hình tuyến tính làm tham số thay vì khung dữ liệu và b) hiển thị các phủ định phù hợp hơn.

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

Cách sử dụng sẽ thay đổi thành:

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

thực sự yêu giải pháp @Ramnath. Để cho phép sử dụng để tùy chỉnh công thức hồi quy (thay vì cố định là y và x dưới dạng tên biến) và thêm giá trị p vào bản in (như @Jerry T đã nhận xét), đây là 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')

Thật không may, điều này không hoạt động với facet_wrap hoặc facet_grid.

Sử dụng 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

Đây là mã đơn giản nhất cho mọi người

Lưu ý: Hiển thị Rho của Pearson chứ không phải 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

Lấy cảm hứng từ kiểu phương trình được cung cấp trong câu trả lời này , một cách tiếp cận chung hơn (nhiều hơn một yếu tố dự đoán + đầu ra latex làm tùy chọn) có thể là:

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

Các model số mong đợi một lmđối tượng, latexđối số là một boolean để yêu cầu một ký tự đơn giản hoặc một phương trình có dạng latex và ...đối số chuyển các giá trị của nó cho formathàm.

Tôi cũng đã thêm một tùy chọn để xuất nó dưới dạng latex để bạn có thể sử dụng chức năng này trong một lần đánh dấu như thế này:

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

Bây giờ sử dụng nó:

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)

Mã này mang lại: y = 11.3382963933174 + 2.5893419 * x + 0.1002227 * z

Và nếu chúng ta yêu cầu một phương trình latex, làm tròn các tham số thành 3 chữ số:

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

Sản lượng này:

Tôi có một nghi ngờ, làm thế nào để đưa một số liệu thống kê đáng chú ý của t.test cho bheta vào phương trình, sử dụng ggpmisc::stat_poly_eq() ?

Ví dụ: expression(hat(Y)== 0000*"**"+0000*"x"*"*"-0000*"x"^2*"**"~~~~"R"^2*":"~~0.000)