r - 用组名及其方程标记 ggplot，可能用 ggpmisc？

Question

我想标记我的情节，可能使用来自 ggpmisc 的方程式方法来提供链接到颜色和方程式的信息标签（然后我可以完全删除图例）。例如，在下图中，理想情况下，方程 LHS 中的因子水平为 4、6 和 8。

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

有一种解决方法是在之后使用此处描述的技术修改绘图，但肯定有更简单的方法吗？

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

# Modification of equation LHS technique from:
# https://stackoverflow.com/questions/56376072/convert-gtable-into-ggplot-in-r-ggplot2
temp <- ggplot_build(p)
temp$data[[3]]$label <- temp$data[[3]]$label %>% 
  fct_relabel(~ str_replace(.x, "y", paste0(c("8","6","4"),"~cylinder:", "~~italic(hat(y))" )))
class(temp)

#convert back to ggplot object
#https://stackoverflow.com/questions/56376072/convert-gtable-into-ggplot-in-r-ggplot2
#install.packages("ggplotify")
library("ggplotify")
q <- as.ggplot(ggplot_gtable(temp))
class(q)
q

score 4 · Accepted Answer

第一个示例将标签放在等式的右侧，并且部分是手动的。另一方面，编码非常简单。之所以有效，是因为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

事实上，通过一点额外的杂耍，几乎可以回答这个问题。我们需要通过显式粘贴来添加lhsaes() ，以便我们可以根据计算变量在其左侧添加粘贴文本。

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

score 2 · Accepted Answer

可以将方程式添加为的手动解决方案怎么样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)

score 1 · Accepted Answer

用方程标记的另一种方法是用拟合线标记。这是一种改编自此处相关问题的答案的方法

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

r - 用组名及其方程标记 ggplot，可能用 ggpmisc？

3 回答 3

Related

Reference