Aggiungi l'equazione della linea di regressione e R ^ 2 sul grafico


228

Mi chiedo come aggiungere l'equazione della linea di regressione e R ^ 2 su ggplot. Il mio codice è:

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

Qualsiasi aiuto sarà molto apprezzato.


1
Per la grafica reticolare , vedere latticeExtra::lmlineq().
Josh O'Brien,

Risposte:


234

Ecco una soluzione

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

MODIFICARE. Ho scoperto la fonte da cui ho scelto questo codice. Ecco il link al post originale nei gruppi google ggplot2

Produzione


1
Il commento di JonasRaedle su come ottenere testi di aspetto migliore annotateera corretto sulla mia macchina.
IRTFM,

2
Questo non assomiglia affatto all'output pubblicato sulla mia macchina, in cui l'etichetta viene sovrascritta tante volte quanti sono i dati chiamati, risultando in un testo di etichetta denso e sfocato. Passare prima le etichette a un data.frame funziona (vedi il mio suggerimento in un commento qui sotto.
PatrickT

@PatrickT: rimuovere il aes(e il corrispondente ). aesserve per mappare le variabili di dataframe su variabili visive - non è necessario qui, poiché esiste solo un'istanza, quindi puoi inserire tutto nella geom_textchiamata principale . Lo modificherò nella risposta.
naught101

Il problema con questa soluzione sembra essere che se il set di dati è più grande (il mio era 370000 osservazioni) la funzione sembra fallire. Consiglierei la soluzione di @kdauria che fa lo stesso, ma molto più velocemente.
Benjamin,

3
per chi desidera valori r e p invece di R2 ed equazione: eq <- substitute (italic (r) ~ "=" ~ rvalue * "," ~ italic (p) ~ "=" ~ pvalue, list (rvalue = sprintf ("% .2f", segno (coef (m) [2]) * sqrt (riepilogo (m) $ r.squared)), pvalue = format (riepilogo (m) $ coefficienti [2,4], cifre = 2 )))
Jerry T

135

Ho incluso una statistica stat_poly_eq()nel mio pacchetto ggpmiscche consente questa risposta:

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

inserisci qui la descrizione dell'immagine

Questa statistica funziona con qualsiasi polinomio senza termini mancanti e si spera abbia abbastanza flessibilità per essere generalmente utile. Le etichette R ^ 2 o R ^ 2 regolate possono essere utilizzate con qualsiasi formula di modello dotata di lm (). Essendo una statistica ggplot si comporta come previsto sia con gruppi che con sfaccettature.

Il pacchetto 'ggpmisc' è disponibile tramite CRAN.

La versione 0.2.6 è stata appena accettata da CRAN.

Risponde ai commenti di @shabbychef e @ MYaseen208.

@ MYaseen208 questo mostra come aggiungere un cappello .

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

inserisci qui la descrizione dell'immagine

@shabbychef Ora è possibile abbinare le variabili dell'equazione a quelle utilizzate per le etichette degli assi. Per sostituire la x con dire z e y con h si potrebbe usare:

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

inserisci qui la descrizione dell'immagine

Essendo queste normali espressioni R analizzate, le lettere greche ora possono anche essere usate sia nell'ls che nel rhs dell'equazione.

[2017-03-08] @elarry Modifica per rispondere in modo più preciso alla domanda originale, mostrando come aggiungere una virgola tra le etichette di equazione e 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

inserisci qui la descrizione dell'immagine

[20-10-2019] @ helen.h fornisco di seguito alcuni esempi di utilizzo stat_poly_eq()con il raggruppamento.

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

inserisci qui la descrizione dell'immagine

inserisci qui la descrizione dell'immagine

[2020-01-21] @Herman Potrebbe essere un po 'controintuitivo a prima vista, ma per ottenere una singola equazione quando si utilizza il raggruppamento è necessario seguire la grammatica della grafica. Limitare la mappatura che crea il raggruppamento su singoli livelli (mostrato di seguito) o mantenere la mappatura predefinita e sovrascriverla con un valore costante nel livello in cui non si desidera il raggruppamento (ad es.colour = "black" .).

Continuando dall'esempio precedente.

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

inserisci qui la descrizione dell'immagine

[2020-01-22] Per completezza un esempio di sfaccettature, dimostrando che anche in questo caso sono soddisfatte le aspettative della grammatica della grafica.

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

inserisci qui la descrizione dell'immagine


1
Va notato che xe ynella formula si riferiscono ai dati xe ynegli strati della trama, e non necessariamente a quelli che al momento my.formulasono costruiti. Quindi la formula dovrebbe sempre usare le variabili xey?
Shabbychef,

E 'molto vero che xe ysi riferiscono alle qualunque variabili vengono mappate a queste estetica. Questa è l'aspettativa anche per geom_smooth () e come funziona la grammatica della grafica. Avrebbe potuto essere più chiaro usare nomi diversi all'interno del frame di dati, ma li ho mantenuti come nella domanda originale.
Pedro Aphalo,

Sarà possibile nella prossima versione di ggpmisc. Grazie per il suggerimento!
Pedro Aphalo,

3
Buon punto @elarry! Questo è correlato a come funziona la funzione parse () di R. Attraverso tentativi ed errori ho scoperto che aes(label = paste(..eq.label.., ..rr.label.., sep = "*plain(\",\")~"))fa il lavoro.
Pedro Aphalo,

1
@HermanToothrot Solitamente R2 è preferito per una regressione, quindi non esiste un'etichetta predefinita r. Nei dati restituiti da stat_poly_eq(). Puoi usare stat_fit_glance(), anche dal pacchetto 'ggpmisc', che restituisce R2 come valore numerico. Vedi esempi nella pagina di aiuto e sostituisci stat(r.squared)con sqrt(stat(r.squared)).
Pedro Aphalo,

99

Ho modificato alcune righe dell'origine stat_smoothe delle funzioni correlate per creare una nuova funzione che aggiunge l'equazione di adattamento e il valore R al quadrato. Funzionerà anche su trame sfaccettate!

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)

inserisci qui la descrizione dell'immagine

Ho usato il codice nella risposta di @ Ramnath per formattare l'equazione. La stat_smooth_funcfunzione non è molto solida, ma non dovrebbe essere difficile giocarci.

https://gist.github.com/kdauria/524eade46135f6348140 . Prova ad aggiornare ggplot2se ricevi un errore.


2
Grazie molto. Questo non funziona solo per le sfaccettature, ma anche per i gruppi. Lo trovo molto utile per le regressioni a tratti, ad es stat_smooth_func(mapping=aes(group=cut(x.val,c(-70,-20,0,20,50,130))),geom="text",method="lm",hjust=0,parse=TRUE). In combinazione con EvaluateSmooths da stackoverflow.com/questions/19735149/…
Julian

1
@aelwan, cambia queste righe: gist.github.com/kdauria/… come preferisci. Quindi sourcel'intero file nel tuo script.
kdauria

1
@kdauria Che cosa succede se ho diverse equazioni in ciascuno dei facet_wraps e ho diversi y_values ​​in ciascuno dei facet_wrap. Qualche suggerimento su come fissare le posizioni delle equazioni? Ho provato diverse opzioni di hjust, vjust e angle usando questo esempio dropbox.com/s/9lk9lug2nwgno2l/R2_facet_wrap.docx?dl=0 ma non sono riuscito a portare tutte le equazioni allo stesso livello in ciascuna delle faccette_wrap
lucido

3
@aelwan, la posizione dell'equazione è determinata da queste righe: gist.github.com/kdauria/… . Ho fatto xpose yposargomenti della funzione nel Gist. Quindi se vuoi che tutte le equazioni si sovrappongano, basta impostare xpose ypos. Altrimenti, xpose yposvengono calcolati dai dati. Se vuoi qualcosa di più elaborato, non dovrebbe essere troppo difficile aggiungere un po 'di logica all'interno della funzione. Ad esempio, forse potresti scrivere una funzione per determinare quale parte del grafico ha lo spazio più vuoto e inserire la funzione lì.
kdauria,

6
Ho riscontrato un errore con source_gist: errore in r_files [[quale]]: tipo di abbonamento 'chiusura' non valido. Vedi questo post per la soluzione: stackoverflow.com/questions/38345894/r-source-gist-not-working
Matifou

73

Ho modificato il post di Ramnath in a) rendendolo più generico in modo che accetti un modello lineare come parametro anziché il frame di dati eb) mostri i negativi in ​​modo più appropriato.

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

L'utilizzo cambierebbe in:

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

17
Questo sembra fantastico! Ma sto disegnando geom_points su più facce, dove il df differisce in base alla variabile facet. Come lo faccio?
bshor,

24
La soluzione di Jayden funziona abbastanza bene, ma il carattere tipografico sembra molto brutto. Vorrei raccomandare di cambiare l'utilizzo in questo: p1 = p + annotate("text", x = 25, y = 300, label = lm_eqn(lm(y ~ x, df)), colour="black", size = 5, parse=TRUE)modifica: questo risolve anche eventuali problemi che potresti avere con le lettere che compaiono nella tua legenda.
Jonas Raedle,

1
@ Jonas, per qualche motivo sto ottenendo "cannot coerce class "lm" to a data.frame". Questa alternativa funziona: df.labs <- data.frame(x = 25, y = 300, label = lm_eqn(df))e p <- p + geom_text(data = df.labs, aes(x = x, y = y, label = label), parse = TRUE)
Patrick T

1
@PatrickT - Questo è il messaggio di errore che riceveresti se chiamassi lm_eqn(lm(...))con la soluzione di Ramnath. Probabilmente hai provato questo dopo aver provato quello ma hai dimenticato di assicurarti di aver ridefinitolm_eqn
Hamy,

@PatrickT: potresti rendere la tua risposta una risposta separata? Sarei felice di votare!
JelenaČuklina,

11

amo davvero la soluzione @Ramnath. Per consentire l'uso per personalizzare la formula di regressione (invece di fissi come y e x come nomi di variabili letterali) e aggiunto il valore p anche nella stampa (come commentato da @Jerry T), ecco la 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')

inserisci qui la descrizione dell'immagine Sfortunatamente, questo non funziona con facet_wrap o facet_grid.


Molto pulito, ho fatto riferimento qui . Un chiarimento: manca il codice ggplot(mtcars, aes(x = wt, y = mpg, group=cyl))+prima di geom_point ()? Una domanda semi-correlata: se ci riferiamo a hp e wt in aes()for ggplot, possiamo quindi afferrarli per usarli nella chiamata a lm_eqn, quindi dobbiamo solo programmare in un unico posto? So che potremmo configurarci xvar = "hp"prima della chiamata ggplot () e usare xvar in entrambe le posizioni per sostituire HP , ma sembra che non dovrebbe essere necessario.
Mark Neal,

9

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

inserisci qui la descrizione dell'immagine

# 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

inserisci qui la descrizione dell'immagine


Hai visto un modo programmatico pulito per specificare un numero per label.y?
Mark Neal,

@MarkNeal potrebbe ottenere il massimo di y quindi moltiplicare per 0,8. label.y = max(df$y) * 0.8
zx8754

1
@MarkNeal punti positivi, forse inviare il problema come richiesta di funzionalità su GitHub ggpubr.
zx8754

1
Problema sulla localizzazione automatica inviato qui
Mark Neal,

1
@ zx8754, nella tua trama è mostrato rho e non R², un modo semplice per mostrare R²?
matmar,

6

Ecco il codice più semplice per tutti

Nota: mostra Pearson's Rho e non 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

Uno di questi esempi con il mio set di dati


Stesso problema di cui sopra, nella tua trama viene mostrato rho e non R²!
matmar,

3

Ispirato allo stile di equazione fornito in questa risposta , un approccio più generico (più di un predittore + output in lattice come opzione) può essere:

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

L' modelargomento si aspetta un lmoggetto, l' latexargomento è un valore booleano per chiedere un carattere semplice o un'equazione in lattice e l' ...argomento passa i suoi valori alformat funzione.

Ho anche aggiunto un'opzione per emetterlo come lattice in modo da poter utilizzare questa funzione in un markdown come questo:


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

Ora usandolo:

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)

Questo codice produce: y = 11.3382963933174 + 2.5893419 * x + 0.1002227 * z

E se chiediamo un'equazione in lattice, arrotondando i parametri a 3 cifre:

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

Questo produce: equazione del lattice


0

Ho un dubbio su come mettere in modo significativo una statistica significativa di t.test per bheta, usando ggpmisc::stat_poly_eq() ?

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

Utilizzando il nostro sito, riconosci di aver letto e compreso le nostre Informativa sui cookie e Informativa sulla privacy.
Licensed under cc by-sa 3.0 with attribution required.