Можем ли мы аккуратно выровнять уравнение регрессии и значения R2 и p?

Question

Каков наилучший (самый простой) подход для аккуратного добавления к ggplot графику уравнения регрессии, R2 и значения p (для уравнения)? В идеале он должен быть совместим с группами и огранкой.

На этом первом графике с уравнением регрессии плюс значения r2 и p по группам, используя ggpubr , но они не выровнены? Я что-то пропустил? Могут ли они быть включены как одна строка?

library(ggplot)
library(ggpubr)

ggplot(mtcars, aes(x = wt, y = mpg, group = cyl))+
  geom_smooth(method="lm")+
  geom_point()+
  stat_regline_equation()+
  stat_cor(aes(label = paste(..rr.label.., ..p.label.., sep = "*`,`~")),
           label.x.npc = "centre")

Вот вариант с ggpmis c, который делает нечетное размещение.
EDIT Нечетное размещение было вызвано geom=text, который я прокомментировал, чтобы обеспечить лучшее размещение, и добавил `label.x =" right ", чтобы остановить переполнение. У нас все еще есть неправильное выравнивание в соответствии с ggpubr , из-за проблемы с верхним индексом, помеченной @ dc37

#https://stackoverflow.com/a/37708832/4927395
library(ggpmisc)

ggplot(mtcars, aes(x = wt, y = mpg, group = cyl))+
  geom_smooth(method="lm")+
  geom_point()+
  stat_poly_eq(formula = "y~x", 
             aes(label = paste(..eq.label.., ..rr.label.., sep = "*`,`~")), 
             parse = TRUE)+
  stat_fit_glance(method = 'lm',
                  method.args = list(formula = "y~x"),
                  #geom = 'text',

                  aes(label = paste("P-value = ", signif(..p.value.., digits = 4), sep = "")))

Я нашел хорошее решение для объединения соответствующих статистических данных, но для этого требуется создать регрессию вне ggplot и кучу пуха по манипуляции со строками - это так просто, как это получается? Кроме того, он не (как в настоящее время закодировано) относится к группировке и не будет иметь дело с фацетированием.

#https://stackoverflow.com/a/51974753/4927395
#Solution as one string, equation, R2 and p-value
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));                 
}

ggplot(mtcars, aes(x = wt, y = mpg, group=cyl))+
  geom_point() +
  geom_text(x=3,y=30,label=lm_eqn(mtcars, 'wt','mpg'),color='red',parse=T) +
  geom_smooth(method='lm')

Answer 1

Я обновил ggpmis c, чтобы сделать это проще. Версия 0.3.4 уже на пути к CRAN, пакет с исходным кодом находится в режиме онлайн, двоичные файлы должны быть собраны за несколько дней.

library(ggpmisc) # version >= 0.3.4 !!

ggplot(mtcars, aes(x = wt, y = mpg, group = cyl)) +
  geom_smooth(method="lm")+
  geom_point()+
  stat_poly_eq(formula = y ~ x, 
               aes(label = paste(..eq.label.., ..rr.label.., ..p.value.label.., sep = "*`,`~")), 
               parse = TRUE,
               label.x.npc = "right",
               vstep = 0.05) # sets vertical spacing

Answer 2

Возможное решение с помощью ggpubr состоит в том, чтобы поместить формулу уравнения и значения R2 в верхнюю часть графика, передав Inf в label.y и Inf или -Inf в label.x (в зависимости от того, хотите ли вы это справа или слева от графика)

Оба текста не будут выровнены из-за верхнего индекса 2 на R. Таким образом, вам придется немного подправить его, используя vjust и hjust чтобы выровнять оба текста.

Тогда он будет работать даже с гранеными графами с разными масштабами.

library(ggplot)
library(ggpubr)

ggplot(mtcars, aes(x = wt, y = mpg, group = cyl))+
  geom_smooth(method="lm")+
  geom_point()+
  stat_regline_equation(label.x = -Inf, label.y = Inf, vjust = 1.5, hjust = -0.1, size = 3)+
  stat_cor(aes(label = paste(..rr.label.., ..p.label.., sep = "*`,`~")),
           label.y= Inf, label.x = Inf, vjust = 1, hjust = 1.1, size = 3)+
  facet_wrap(~cyl, scales = "free")

Отвечает ли он на ваш вопрос?

---

РЕДАКТИРОВАТЬ: Альтернатива путем добавления уравнения вручную

Как описано в вашем аналогичном вопросе ( Пометить группы ggplot с помощью уравнения с ggpmis c), вы можете добавить свое уравнение, передав текст как geom_text:

df_mtcars <- mtcars %>% mutate(factor_cyl = as.factor(cyl))

df_label <- df_mtcars %>% group_by(factor_cyl) %>%
  summarise(Inter = lm(mpg~wt)$coefficients[1],
            Coeff = lm(mpg~wt)$coefficients[2],
            pval = summary(lm(mpg~wt))$coefficients[2,4],
            r2 = summary(lm(mpg~wt))$r.squared) %>% ungroup() %>%
  #mutate(ypos = max(df_mtcars$mpg)*(1-0.05*row_number())) %>%
  #mutate(Label2 = paste(factor_cyl,"~Cylinders:~", "italic(y)==",round(Inter,3),ifelse(Coeff <0,"-","+"),round(abs(Coeff),3),"~italic(x)",sep ="")) %>%
  mutate(Label = paste("italic(y)==",round(Inter,3),ifelse(Coeff <0,"-","+"),round(abs(Coeff),3),"~italic(x)",
                       "~~~~italic(R^2)==",round(r2,3),"~~italic(p)==",round(pval,3),sep =""))

# A tibble: 3 x 6
  factor_cyl Inter Coeff   pval    r2 Label                                                                    
  <fct>      <dbl> <dbl>  <dbl> <dbl> <chr>                                                                    
1 4           39.6 -5.65 0.0137 0.509 italic(y)==39.571-5.647~italic(x)~~~~italic(R^2)==0.509~~italic(p)==0.014
2 6           28.4 -2.78 0.0918 0.465 italic(y)==28.409-2.78~italic(x)~~~~italic(R^2)==0.465~~italic(p)==0.092 
3 8           23.9 -2.19 0.0118 0.423 italic(y)==23.868-2.192~italic(x)~~~~italic(R^2)==0.423~~italic(p)==0.012

И вы можете использовать его для geom_text следующим образом:

ggplot(df_mtcars,aes(x = wt, y = mpg, group = factor_cyl, colour= factor_cyl))+
  geom_smooth(method="lm")+
  geom_point()+
  geom_text(data = df_label,
            aes(x = -Inf, y = Inf, 
                label = Label, color = factor_cyl), 
          show.legend = FALSE, parse = TRUE, size = 3,vjust = 1, hjust = 0)+
  facet_wrap(~factor_cyl)

По крайней мере, это решает проблему неправильного выравнивания из-за верхнего индекса 2 на R.

Answer 3

Здесь я использую ggpmis c, с одним вызовом stat_poly_eq() для уравнения (в центре вверху) и одним вызовом stat_fit_glance() для статистики (pvalue и r2). Секретным соусом для выравнивания является использование yhat в качестве левой части уравнения, поскольку шляпа аппроксимирует высоту текста, которая затем совпадает с верхним индексом для кончика шляпы r2, с Педро Афало для yhat, показанным здесь .

Было бы замечательно иметь их как одну строку, что означает, что горизонтальное выравнивание не будет проблемой, и тогда удобнее найти его в пространстве графика. Я поднял как вопросы на ggpubr и ggpmis c.

Я с радостью приму другой лучший ответ!

library(ggpmisc)

df_mtcars <- mtcars %>% mutate(factor_cyl = as.factor(cyl))

my_formula <- "y~x"

ggplot(df_mtcars, aes(x = wt, y = mpg, group = factor_cyl, colour= factor_cyl))+
  geom_smooth(method="lm")+
  geom_point()+
  stat_poly_eq(formula = my_formula,
               label.x = "centre",
               eq.with.lhs = "italic(hat(y))~`=`~",
               aes(label = paste(..eq.label.., sep = "~~~")), 
               parse = TRUE)+
  stat_fit_glance(method = 'lm',
                  method.args = list(formula = my_formula),
                  #geom = 'text',
                  label.x = "right", #added to prevent overplotting
                  aes(label = paste("~italic(p) ==", round(..p.value.., digits = 3),
                                    "~italic(R)^2 ==", round(..r.squared.., digits = 2),
                                    sep = "~")),
                  parse=TRUE)+
  theme_minimal()

Фасет примечания также работает аккуратно, и вы можете иметь различные переменные для фасета и группировки, и все по-прежнему работает.

Примечание. Если вы используете одну и ту же переменную для группы и для фасета, добавление label.y= Inf, к каждому вызову приведет к метке в верхней части каждого фасета ( hat tip @ dc37, в другом ответе на этот вопрос).