Grafiğe regresyon çizgisi denklemi ve R ^ 2 ekleme

Nasıl regresyon satırı denklemi ve R ^ 2 eklemek için ggplot. Kodum:

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

Herhangi bir yardım çok takdir edilecektir.

İşte bir çözüm

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

DÜZENLE. Bu kodu nereden aldığımı anladım. İşte ggplot2 google gruplarındaki orijinal gönderinin bağlantısı

stat_poly_eq()Paketimi ggpmiscşu yanıta izin veren bir istatistik ekledim:

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

Bu istatistik, eksik terimleri olmayan herhangi bir polinom ile çalışır ve umarım genel olarak yararlı olmak için yeterli esnekliğe sahiptir. R ^ 2 veya ayarlanmış R ^ 2 etiketleri, lm () ile donatılmış herhangi bir model formülüyle kullanılabilir. Bir ggplot istatistiği olarak hem gruplarda hem de modellerde beklendiği gibi davranır.

'Ggpmisc' paketi CRAN aracılığıyla edinilebilir.

Sürüm 0.2.6 sadece CRAN'a kabul edildi.

@Shabbychef ve @ MYaseen208 tarafından yapılan yorumları ele almaktadır.

@ MYaseen208 bu nasıl şapka ekleneceğini gösterir .

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 Denklemdeki değişkenleri eksen etiketleri için kullanılan değişkenlerle eşleştirmek mümkündür. Değiştirmek için x diyelim ki z ve y ile saat bir kullanmak:

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

Bu normal R çözümlü ifadeler olan Yunan harfleri artık denklemin hem lh'lerinde hem de rh'lerinde kullanılabilir.

[2017-03-08] @elarry Denklem ve R2 etiketleri arasına nasıl virgül ekleneceğini gösteren orijinal soruyu daha kesin bir şekilde ele almak için düzenleyin.

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 Aşağıda stat_poly_eq()gruplama ile kullanım örnekleri verdim .

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 İlk bakışta biraz sezgisel olabilir, ancak gruplama kullanırken tek bir denklem elde etmek için grafiklerin gramerini takip etmek gerekir. Gruplamayı oluşturan eşlemeyi tek tek katmanlarla (aşağıda gösterilen) kısıtlayın ya da varsayılan eşlemeyi koruyun ve katmanda, gruplandırmayı istemediğiniz sabit bir değerle geçersiz kılın (ör. colour = "black").

Önceki örnekten devam.

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] Bütünlük adına, fasetlerle ilgili bir örnek, bu durumda grafik gramerinin beklentilerinin de yerine getirildiğini gösterir.

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

stat_smoothUyum denklemini ve R kare değerini ekleyen yeni bir işlev yapmak için kaynağının ve ilgili işlevlerin birkaç satırını değiştirdim . Bu faset parsellerde de işe yarayacak!

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)

Denklemi biçimlendirmek için @ Ramnath'ın cevabındaki kodu kullandım. stat_smooth_funcİşlevi çok sağlam değil, ama onunla uğraşmak zor olmamalı.

https://gist.github.com/kdauria/524eade46135f6348140 . ggplot2Bir hata alırsanız güncellemeyi deneyin .

Ramnath'ın gönderisini bir) daha genel hale getirdim, böylece veri çerçevesinden ziyade doğrusal bir modeli parametre olarak kabul eder ve b) negatifleri daha uygun şekilde görüntüler.

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

Kullanım şu şekilde değişecektir:

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

@Ramnath çözümünü gerçekten çok seviyorum. Regresyon formülünü özelleştirmek için kullanıma izin vermek için (değişmez değişken adları olarak y ve x olarak sabitlenmek yerine) ve p değerini çıktıya da eklemek için (@Jerry T yorumladı gibi), 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')

Ne yazık ki, bu facet_wrap veya facet_grid ile çalışmaz.

Ggpubr kullanma :

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

İşte herkes için en basit kod

Not: R ^ 2 değil Pearson Rho gösteriliyor .

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

Bu cevapta verilen denklem stilinden esinlenerek , daha genel bir yaklaşım (seçenek olarak birden fazla öngörücü + lateks çıkışı) şunlar olabilir:

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

Bağımsız modeldeğişken bir lmnesne bekler , latexbağımsız değişken basit bir karakter veya lateks biçimli bir denklem istemek için bir boole'dir ve ...bağımsız değişken değerlerini formatişleve iletir.

Ayrıca, lateks olarak çıktı almak için bir seçenek ekledim, böylece bu işlevi aşağıdaki gibi bir geri yüklemede kullanabilirsiniz:

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

Şimdi kullanıyor:

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)

Bu kod şunları sağlar: y = 11.3382963933174 + 2.5893419 * x + 0.1002227 * z

Ve bir lateks denklemi istiyorsak, parametreleri 3 basamağa yuvarlarız:

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

Bu şu sonuçları verir:

Şüphe var, nasıl denklemde bheta için t.test önemli istatistikleri koymak, kullanarak ggpmisc::stat_poly_eq()?

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