回帰直線方程式とR ^ 2をグラフに追加


228

に回帰直線方程式と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

ここに1つの解決策があります

# 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 groupsの元の投稿へのリンクです

出力


1
@JonasRaedleのテキストの見栄えを良くすることに関するコメントannotateは、私のマシンでは正しかった。
IRTFM 2013

2
これは、私のマシンにポストされた出力のようには見えません。ラベルがデータが呼び出されると何度も上書きされるため、ラベルテキストが厚くぼやけてしまいます。data.frame最初の作品にラベルを渡す(以下のコメントに私の提案を参照してください。
PatrickT

@PatrickT:aes(と対応するを削除し)ます。aesデータフレーム変数をビジュアル変数にマッピングするためのものです。インスタンスが1つしかないため、ここでは必要ありませんgeom_text。すべてをメインの呼び出しに入れることができます。これを答えに編集します。
naught101

このソリューションの問題は、データセットが大きい場合(私の観測値は370000観測)、関数が失敗したように見えることです。私は同じことをしますが、はるかに速い@kdauriaからの解決策をお勧めします。
ベンジャミン

3
R2と方程式の代わりにrとpの値が必要な場合:eq <-substitute(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]、digits = 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をたとえばzにyhに置き換えるには、次のようにします。

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式が参照xし、y一度範囲のものに限らないと、プロットのレイヤのデータmy.formula構成されています。したがって、式は常に xおよびy変数を使用する必要ありますか?
shabbychef 2016

これらの美学にマッピングされているすべての変数xy参照することは非常に真実です。それはgeom_smooth()とグラフィックスの文法がどのように機能するかについても期待されています。データフレーム内で別の名前を使用する方がわかりやすいかもしれませんが、元の質問と同じようにそのままにしました。
ペドロアファロ2016

の次のバージョンで可能になりggpmiscます。提案をありがとう!
Pedro Aphalo 2016

3
良い点@elarry!これは、Rのparse()関数の動作に関連しています。試行錯誤の末、私はそれaes(label = paste(..eq.label.., ..rr.label.., sep = "*plain(\",\")~"))が仕事をすることを発見しました。
Pedro Aphalo 2017

1
@HermanToothrot通常、回帰にはR2が推奨されるため、によって返されるデータに事前定義されたr.labelはありませんstat_poly_eq()stat_fit_glance()R2を数値として返すパッケージ 'ggpmisc'からも使用できます。ヘルプページの例を参照してください、と置き換えるstat(r.squared)ことでsqrt(stat(r.squared))
ペドロアファロ

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
Julian

1
@aelwan、これらの行を変更してください:gist.github.com/kdauria/…好きなように。次にsource、スクリプト内のファイル全体。
kdauria

1
@kdauria facet_wrapsのそれぞれにいくつかの方程式があり、facet_wrapのそれぞれに異なるy_valueがある場合はどうなりますか。方程式の位置を修正する方法はありますか?私は、この例で使用したhjust、vjustと角度のいくつかのオプションを試してみましたdropbox.com/s/9lk9lug2nwgno2l/R2_facet_wrap.docx?dl=0を私はfacet_wrapのそれぞれに同じレベルですべての方程式をもたらすことができませんでした
光沢のある

3
@aelwan、方程式の位置は次の行によって決定されます:gist.github.com/kdauria/…。Gistで関数の引数を作成xposyposました。ですから、重複、ちょうどセットにすべての方程式を望んでいた場合xposypos。そうでない場合、xposおよびyposデータから計算されます。より洗練されたものが必要な場合は、関数内にロジックを追加することはそれほど難しくありません。たとえば、グラフのどの部分に最も空きスペースがあるかを判断する関数を記述して、そこに関数を配置することができます。
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
ジェイデンのソリューションは非常にうまく機能しますが、書体は非常に醜く見えます。使用方法を次のように変更することをお勧めします。p1 = p + annotate("text", x = 25, y = 300, label = lm_eqn(lm(y ~ x, df)), colour="black", size = 5, parse=TRUE)編集:これにより、凡例に表示される文字に関する問題も解決されます。
Jonas Raedle 2013

1
@ジョナス、何らかの理由で私は得てい"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

@PatrickT:あなたの答えを別の答えにすることができますか?ぜひ投票してください!
JelenaČuklina

11

@Ramnathソリューションが本当に大好きです。(リテラル変数名としてyおよびxとして固定する代わりに)回帰式をカスタマイズし、(@ Jerry Tがコメントしたように)p値も印刷に追加できるようにするには、次の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()、それらを取得してへの呼び出しで使用できるlm_eqnので、1か所でコーディングするだけで済みますか?xvar = "hp"ggplot()呼び出しの前にセットアップし、両方の場所でxvarを使用してhpを置き換えることができることはわかっていますが、これ不要なはずです。
マークニール

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で表示されます。R²を表示する簡単な方法はありますか?
matmar

6

誰にとっても最も単純なコードは次のとおりです

注: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

私自身のデータセットを使用したそのような例の1つ


上記と同じ問題、プロットではR²ではなくrhoが表示されます!
matmar

3

この回答で提供されている方程式スタイルに触発されて、より一般的なアプローチ(複数の予測子+オプションとしてのlatex出力)は次のようになります。

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で使用できるように、latexとして出力するオプションも追加しました。


```{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)

弊社のサイトを使用することにより、あなたは弊社のクッキーポリシーおよびプライバシーポリシーを読み、理解したものとみなされます。
Licensed under cc by-sa 3.0 with attribution required.