Пометьте ggplot именами групп и их уравнением, возможно, ggpmis c?

Question

Я хотел бы обозначить свой график, возможно, используя метод уравнения из ggpmis c, чтобы дать информативную метку, которая ссылается на цвет и уравнение (тогда я могу полностью удалить легенду). Например, на графике ниже я бы в идеале имел уровни факторов 4, 6 и 8 в уравнении LHS.

library(tidyverse)
library(ggpmisc)

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

p <- 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 = paste0(expression(y), "~`=`~"),
               eq.with.lhs = paste0("Group~factor~level~here", "~Cylinders:", "~italic(hat(y))~`=`~"),
               aes(label = paste(..eq.label.., sep = "~~~")), 
               parse = TRUE)
p

Существует обходной путь путем изменения графика впоследствии, используя методику, описанную здесь , но наверняка есть что-то более простое?

Answer 1

Этот первый пример помещает метку справа от уравнения и является частично ручным. С другой стороны, это очень просто кодировать. Почему это работает, потому что group всегда присутствует в data, как видно из функций слоя (статистика и геометрия).

library(tidyverse)
library(ggpmisc)

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

my_formula <- y ~ x

p <- 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(stat(eq.label), "*\", \"*", 
                                 c("4", "6", "8")[stat(group)], 
                                 "~cylinders.",  sep = "")),
               label.x.npc = "right",
               parse = TRUE) +
  scale_colour_discrete(guide = FALSE)
p

На самом деле с небольшим количеством дополнительного жонглирования можно получить почти ответ на вопрос. Нам нужно добавить lhs , вставив его явно в aes(), чтобы мы могли также добавить текст слева от него на основе вычисляемой переменной.

library(tidyverse)
library(ggpmisc)

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

my_formula <- y ~ x

p <- 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 = "",
               aes(label = paste("bold(\"", c("4", "6", "8")[stat(group)], 
                                 " cylinders:  \")*",
                                 "italic(hat(y))~`=`~",
                                 stat(eq.label),
                                 sep = "")),
               label.x.npc = "right",
               parse = TRUE) +
  scale_colour_discrete(guide = FALSE)
p 

Answer 2

Как насчет ручного решения, в котором вы можете добавить свое уравнение в виде geom_text?

Плюсы: высокая настройка / Минусы: необходимо редактировать вручную на основе вашего уравнения

Здесь, используя ваш пример и линейная регрессия:

library(tidyverse)

df_label <- df_mtcars %>% group_by(factor_cyl) %>%
  summarise(Inter = lm(mpg~wt)$coefficients[1],
            Coeff = lm(mpg~wt)$coefficients[2]) %>% ungroup() %>%
  mutate(ypos = max(df_mtcars$mpg)*(1-0.05*row_number())) %>%
  mutate(Label2 = paste(factor_cyl,"~Cylinders:~", "italic(y)==",round(Inter,2),ifelse(Coeff <0,"-","+"),round(abs(Coeff),2),"~italic(x)",sep =""))

# A tibble: 3 x 5
  factor_cyl Inter Coeff  ypos Label2                                      
  <fct>      <dbl> <dbl> <dbl> <chr>                                       
1 4           39.6 -5.65  32.2 4~Cylinders:~italic(y)==39.57-5.65~italic(x)
2 6           28.4 -2.78  30.5 6~Cylinders:~italic(y)==28.41-2.78~italic(x)
3 8           23.9 -2.19  28.8 8~Cylinders:~italic(y)==23.87-2.19~italic(x)

Теперь вы можете передать его в ggplot2:

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 = 2.5, y = ypos, 
                label = Label2, color = factor_cyl), 
            hjust = 0, show.legend = FALSE, parse = TRUE)

Answer 3

Альтернативой маркировке с помощью уравнения является маркировка с помощью соответствующей линии. Вот подход, адаптированный из ответа на связанный вопрос здесь

#example of loess for multiple models
#https://stackoverflow.com/a/55127487/4927395
library(tidyverse)
library(ggpmisc)

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

models <- df_mtcars %>%
  tidyr::nest(-cyl) %>%
  dplyr::mutate(
    # Perform loess calculation on each CpG group
    m = purrr::map(data, lm,
                   formula = mpg ~ wt),
    # Retrieve the fitted values from each model
    fitted = purrr::map(m, `[[`, "fitted.values")
  )

# Apply fitted y's as a new column
results <- models %>%
  dplyr::select(-m) %>%
  tidyr::unnest()

#find final x values for each group
my_last_points <- results %>% group_by(cyl) %>% summarise(wt = max(wt, na.rm=TRUE))

#Join dataframe of predictions to group labels
my_last_points$pred_y <- left_join(my_last_points, results)

# Plot with loess line for each group
ggplot(results, aes(x = wt, y = mpg, group = cyl, colour = cyl)) +
  geom_point(size=1) +
  geom_smooth(method="lm",se=FALSE)+
  geom_text(data = my_last_points, aes(x=wt+0.4, y=pred_y$fitted, label = paste0(cyl," Cylinders")))+
  theme(legend.position = "none")+  
  stat_poly_eq(formula = "y~x",
             label.x = "centre",
             eq.with.lhs = paste0(expression(y), "~`=`~"),
             aes(label = paste(..eq.label.., sep = "~~~")), 
             parse = TRUE)