Добавить уравнение линии регрессии и 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

Любая помощь будет высоко оценена.

MYaseen208
источник
1
Графики решетки см latticeExtra::lmlineq().
Джош О'Брайен

Ответы:

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 гугл группах

Вывод

Ramnath
источник
1
Комментарий @ JonasRaedle о том, как лучше выглядеть тексты, annotateбыл верным на моей машине.
IRTFM
2
Это не похоже на опубликованный вывод на моем компьютере, где метка перезаписывается столько раз, сколько вызывается данных, в результате чего получается толстый и размытый текст метки. Передача меток в data.frame сначала работает (см. Мое предложение в комментарии ниже.
PatrickT
@PatrickT: удалить aes(и соответствующие ). aesпредназначен для отображения переменных dataframe в визуальные переменные - здесь это не нужно, поскольку есть только один экземпляр, так что вы можете поместить все это в основной geom_textвызов. Я отредактирую это в ответ.
naught101
Проблема с этим решением, по-видимому, заключается в том, что если набор данных больше (у меня было 370000 наблюдений), то, похоже, функция не работает. Я бы порекомендовал решение от @kdauria, которое делает то же самое, но намного быстрее.
Бенджамин
3
для тех, кто хочет значения r и p вместо R2 и уравнения: eq <- подставить (курсив (r) ~ "=" ~ rvalue * "," ~ курсив (p) ~ "=" ~ pvalue, список (rvalue = sprintf) ("% .2f", знак (coef (m) [2]) * sqrt (итоговый (m) $ r.squared)), pvalue = формат (суммарный (m) $ коэффициент [2,4], цифры = 2 )))
Джерри Т
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, а y на h, можно использовать:

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 разобранными выражениями, греческие буквы теперь также могут использоваться как в левых, так и в правых частях уравнения.

[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
Следует отметить , что xи yв формуле обратитесь к xи yданным в слоях сюжета, и не обязательно к тем , в области видимости в момент my.formulaстроится. Таким образом, формула всегда должна использовать переменные x и y?
Шаббычеф
Это очень верно xи yотносится к любым переменным, сопоставленным с этой эстетикой. Это ожидание также для geom_smooth () и того, как работает грамматика графики. Было бы яснее использовать разные имена внутри фрейма данных, но я просто сохранил их, как в первоначальном вопросе.
Педро Афало
Будет возможно в следующей версии ggpmisc. Спасибо за предложение!
Педро Афало
3
Хороший вопрос @elarry! Это связано с тем, как работает функция parse (). Методом проб и ошибок я обнаружил, что aes(label = paste(..eq.label.., ..rr.label.., sep = "*plain(\",\")~"))делает свою работу.
Педро Афало
1
@HermanToothrot Обычно R2 предпочтительнее для регрессии, поэтому в данных, возвращаемых посредством stat_poly_eq()., Отсутствует предопределенная r.label . Вы также можете использовать stat_fit_glance()пакет ggpmisc, который возвращает R2 в виде числового значения. Смотрите примеры на странице справки и заменяйте 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/524eade46135f6348140 . Попробуйте обновить, ggplot2если вы получили ошибку.

kdauria
источник
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), в сочетании с EvaluateSmooths из stackoverflow.com/questions/19735149/…
Джулиан
1
@aelwan, измените эти строки: gist.github.com/kdauria/… как хотите. Тогда sourceвесь файл в вашем скрипте.
Кдаурия
1
@kdauria Что делать, если у меня есть несколько уравнений в каждом из facet_wraps, и у меня разные значения y_ в каждом из facet_wrap. Любые предложения, как исправить положения уравнений? Я попробовал несколько вариантов hjust, vjust и angle, используя этот пример dropbox.com/s/9lk9lug2nwgno2l/R2_facet_wrap.docx?dl=0, но я не смог привести все уравнения на одном уровне в каждом из facet_wrap
блестящий
3
@aelwan, положение уравнения определяется этими строками: gist.github.com/kdauria/… . Я сделал xposи yposаргументы функции в Gist. Поэтому, если вы хотите, чтобы все уравнения перекрывались, просто установите xposи ypos. В противном случае xposи yposрассчитываются по данным. Если вы хотите что-то более изощренное, не должно быть слишком сложно добавить немного логики в функцию. Например, может быть, вы могли бы написать функцию, чтобы определить, какая часть графика имеет наибольшее пустое пространство, и поместить эту функцию туда.
kdauria
6
Я столкнулся с ошибкой source_gist: Ошибка в r_files [[which]]: недопустимый тип индекса «закрытие». См. Этот пост для решения: stackoverflow.com/questions/38345894/r-source-gist-not-working
Matifou
73

Я изменил пост Рамната: а) сделать более общим, чтобы он принимал линейную модель в качестве параметра, а не фрейм данных, и б) отображал негативы более подходящим образом.

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)edit: это также решает любые проблемы, которые могут возникнуть при отображении писем в вашей легенде.
Джонас Ридл
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(...)). Вы, вероятно, попробовали этот после того, как попробовали тот, но забыли убедиться, что вы переопределилиlm_eqn
Hamy
@PatrickT: не могли бы вы сделать свой ответ отдельным ответом? Я был бы рад проголосовать!
Елена Чуклина
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.

XX
источник
Очень аккуратно, я упоминал здесь . Уточнение - ваш код отсутствует ggplot(mtcars, aes(x = wt, y = mpg, group=cyl))+до geom_point ()? Наполовину связанный вопрос - если мы ссылаемся на hp и wt в aes()for ggplot, можем ли мы затем взять их для использования в вызове lm_eqn, так что тогда мы должны кодировать только в одном месте? Я знаю, что мы могли бы установить 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

введите описание изображения здесь

zx8754
источник
Вы видели аккуратный программный способ указать число для label.y?
Марк Нил
@MarkNeal может получить максимальное значение y, а затем умножить на 0,8. label.y = max(df$y) * 0.8
zx8754
1
@MarkNeal хорошие моменты, возможно, отправьте вопрос в виде запроса функции на GitHub ggpubr.
zx8754
1
Вопрос об авто локации представлен здесь
Марк Нил
1
@ zx8754, в твоем сюжете показано rho, а не R², есть ли простой способ показать R²?
Матмар
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

Один такой пример с моим собственным набором данных

Sork-каль
источник
Та же проблема, что и выше, на вашем графике показано Rho, а не R²!
Матмар
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)

Это дает: уравнение латекса

rvezy
источник
0

У меня есть сомнение, как поставить значимую статистику t.test для bheta в уравнении, используя ggpmisc::stat_poly_eq()?

например: expression(hat(Y)== 0000*"**"+0000*"x"*"*"-0000*"x"^2*"**"~~~~"R"^2*":"~~0.000)

Жан Карлос
источник