그래프에 회귀선 방정식 및 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().
Josh O'Brien

답변:


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 : 제거 aes(하고 해당 ). aes데이터 프레임 변수를 시각적 변수에 매핑하기위한 것입니다. 여기에는 필요하지 않습니다. 인스턴스가 하나뿐이므로 주 geom_text호출에 모두 넣을 수 있습니다 . 이 답변을 수정하겠습니다.
naught101

이 솔루션의 문제점은 데이터 세트가 더 큰 경우 (광산이 370000 개의 관측치) 기능이 실패한 것 같습니다. @kdauria의 솔루션을 권장하지만 똑같지 만 훨씬 빠릅니다.
Benjamin

3
R2와 방정식 대신 r과 p 값을 원하는 사람들을 위해 : eq <-replacement (italic (r) ~ "="~ rvalue * ","~ italic (p) ~ "="~ pvalue, list (rvalue = sprintf ( "% .2f", sign (coef (m) [2]) * sqrt (요약 (m) $ r.squared)), pvalue = 형식 (요약 (m) $ 계수 [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 통계이기 때문에 그룹 및 패싯 모두에서 예상대로 작동합니다.

'ggpmisc'패키지는 CRAN을 통해 제공됩니다.

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 말의와 ZYH 사람이 사용하는 것을 :

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 수식과 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

매우 사실 xy이러한 미학에 매핑 된 어떤 변수를 참조하십시오. 그것은 geom_smooth ()에 대한 기대와 그래픽 문법 작동 방식입니다. 데이터 프레임 내에서 다른 이름을 사용하는 것이 더 명확했을 수도 있지만 원래 질문과 같이 그대로 유지했습니다.
Pedro Aphalo

의 다음 버전에서 가능합니다 ggpmisc. 제안 해 주셔서 감사합니다!
Pedro Aphalo

3
좋은 점 @elarry! 이것은 R의 parse () 함수 작동 방식과 관련이 있습니다. 시행 착오를 통해 aes(label = paste(..eq.label.., ..rr.label.., sep = "*plain(\",\")~"))그 일을 한다는 것을 알았 습니다.
Pedro Aphalo

1
@HermanToothrot 일반적으로 R2는 회귀 분석에 선호되므로로 반환되는 데이터에 사전 정의 된 r.label이 없습니다 stat_poly_eq(). stat_fit_glance()패키지 'ggpmisc'에서도 R2를 숫자 값으로 반환하는을 사용할 수 있습니다 . 도움말 페이지의 예를 참조하고, 교체 stat(r.squared)에 의해 sqrt(stat(r.squared)).
페드로 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/524eade46135f6348140 . ggplot2오류가 발생하면 업데이트를 시도하십시오 .


2
많은 감사합니다. 이것은 패싯뿐만 아니라 그룹에서도 작동합니다. 예를 들어 stackoverflow.com/questions/19735149/의stat_smooth_func(mapping=aes(group=cut(x.val,c(-70,-20,0,20,50,130))),geom="text",method="lm",hjust=0,parse=TRUE) EvaluateSmooths와 함께 조각 단위 회귀에 매우 유용합니다.
Julian

1
@aelwan,이 라인을 변경 : gist.github.com/kdauria/... 당신이 원하는대로. 그런 다음 source스크립트의 전체 파일입니다.
크다 우리아

1
@kdauria 각 facet_wrap에 여러 개의 방정식이 있고 각 facet_wrap에 다른 y_value가있는 경우 어떻게해야합니까? 방정식의 위치를 ​​고정하는 방법에 대한 제안이 있습니까? 나는이 예를 사용하여 hjust, vjust 각도의 여러 가지 옵션을 시도 dropbox.com/s/9lk9lug2nwgno2l/R2_facet_wrap.docx?dl=0을 하지만 난 facet_wrap의 각 동일한 수준에있는 모든 방정식을 가져올 수 없었다
반짝

3
@aelwan, 방정식의 총수는 다음 행에 의해 결정된다 : gist.github.com/kdauria/...를 . 내가 만든 xpos하고 ypos요점에서 함수의 인수. 당신이 중복 모든 방정식을 원하는 그렇다면, 단지 설정 xpos하고 ypos. 그렇지 않으면, xposypos데이터에서 계산됩니다. 더 멋진 것을 원한다면 함수 안에 논리를 추가하는 것이 너무 어렵지 않아야합니다. 예를 들어, 그래프에서 가장 빈 공간이있는 부분을 결정하는 함수를 작성할 수 있습니다.
kdauria

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는 패싯 변수에 따라 다릅니다. 어떻게합니까?
bshor

24
Jayden의 솔루션은 꽤 잘 작동하지만 서체는 매우 못 생겼습니다. 사용법을 다음과 같이 변경하는 것이 좋습니다. p1 = p + annotate("text", x = 25, y = 300, label = lm_eqn(lm(y ~ x, df)), colour="black", size = 5, parse=TRUE)edit : 이렇게하면 범례에 글자로 표시되는 모든 문제가 해결됩니다.
Jonas Raedle

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

1
@PatrickT- lm_eqn(lm(...))Ramnath의 솔루션으로 전화하면 오류 메시지가 나타납니다 . 당신은 아마 그것을 시도한 후에 이것을 시도했지만 당신이 재정의했는지를 잊어 버렸습니다lm_eqn
Hamy

@ 패트릭 : 답변을 별도의 답변으로 만들 수 있습니까? 기꺼이 투표하겠습니다!
JelenaČuklina

11

@Ramnath 솔루션을 정말 좋아합니다. 리터럴 변수 이름으로 y 및 x로 고정되는 대신 회귀 수식을 사용자 정의하고 인쇄물에 p- 값을 추가하기 위해 @Jerry T가 주석을 추가하는 데 사용하려면 다음과 같은 모드가 있습니다.

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 () 전에 되었습니까? 반 관련된 질문 - 우리가 참조하는 경우 마력중량aes()ggplot, 우리가 다음 수 있습니다 잡아 호출에 사용하도록 lm_eqn, 그래서 우리는 한 곳에서 코드가? 나는 우리가 설정할 수 알고 xvar = "hp"대체하는 두 위치에서 ggplot () 호출 및 사용 xvar 전에 마력 ,하지만 Feel로 그 같은 불필요한되어야한다.
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?
마크 닐

@MarkNeal은 y의 최대 값을 얻은 다음 0.8을 곱합니다. label.y = max(df$y) * 0.8
zx8754

1
@ MarkNeal 좋은 점, GitHub ggpubr에서 기능 요청으로 문제를 제출할 수 있습니다.
zx8754


1
@ zx8754, 당신의 음모에는 R²가 아니라 rho로 표시됩니다.
matmar

5

모든 사람을위한 가장 간단한 코드는 다음과 같습니다.

참고 : R ^ 2가 아닌 Pearson의 Rho를 표시 합니다.

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

내 데이터 세트가있는 그러한 예


위와 같은 문제, 당신의 음모에는 R²이 아니라 rho로 표시됩니다!
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

나는 bheta에 대한 t.test의 중요한 통계를 방정식에 넣는 방법을 의심합니다. ggpmisc::stat_poly_eq() ?

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

당사 사이트를 사용함과 동시에 당사의 쿠키 정책개인정보 보호정책을 읽고 이해하였음을 인정하는 것으로 간주합니다.
Licensed under cc by-sa 3.0 with attribution required.