r - 在ggplot2中将数据映射到图例文本颜色的有效方法

Question

我想知道是否有一种有效的方法可以将数据映射到 ggplot2 中的图例文本颜色，就像我们可以使用轴文本一样。可重现的示例如下。

首先，让我们做一个情节:

library(ggplot2)
library(dplyr)

drv_counts <- mutate(mpg,
                     drv = case_when(drv == "r" ~ "rear wheel drive",
                                     drv == "4" ~ "4 wheel drive",
                                     drv == "f" ~ "front wheel drive"),
                     model_drv = interaction(model, drv)) %>%
  group_by(model_drv) %>%
  summarize(model = model[1], drv = drv[1], count = n()) %>%
  arrange(drv, count) %>%
  mutate(model = factor(model, levels = model))

p <- ggplot(drv_counts, aes(x=model, y=count, fill=drv)) +
  geom_col() + coord_flip() + guides(fill = guide_legend(reverse=T)) +
  theme_minimal()
p

现在让我们按传动系统为轴标签着色。这很容易:

# ggplot2 colors
cols <- c("4 wheel drive" = "#F8766D", "front wheel drive" = "#00BA38", "rear wheel drive" = "#619CFF")

p2 <- p + theme(axis.text.y = element_text(color = cols[drv_counts$drv]))
p2

现在让我们在图例上尝试相同的技巧。它不起作用:

p2 + theme(legend.text = element_text(color = cols))

这对图例文本不起作用但对轴文本起作用的原因是所有轴标签都绘制在一个 grob 中，因此我们可以给 grob 一个颜色向量，但图例标签是在单独的 grob 中绘制的。

我们可以手动给所有的 grobs 上色，但这非常丑陋和麻烦:

g <- ggplotGrob(p2)
g$grobs[[15]]$grobs[[1]]$grobs[[9]]$children[[1]]$gp$col <- cols[g$grobs[[15]]$grobs[[1]]$grobs[[9]]$children[[1]]$label]
g$grobs[[15]]$grobs[[1]]$grobs[[10]]$children[[1]]$gp$col <- cols[g$grobs[[15]]$grobs[[1]]$grobs[[10]]$children[[1]]$label]
g$grobs[[15]]$grobs[[1]]$grobs[[11]]$children[[1]]$gp$col <- cols[g$grobs[[15]]$grobs[[1]]$grobs[[11]]$children[[1]]$label]
grid::grid.newpage()
grid::grid.draw(g)

我的问题是:有人能想出一种方法来获得这种效果，而不必深入挖掘树吗？如果只有几行修改过，我可以对 ggplot2 打补丁。或者，是否可以自动深入挖掘 grob 树，这样我就不必通过手动设置列表索引来访问子 grobs，列表索引将在我对图形进行细微更改时发生变化？

更新:相关问题可以在 here. 中找到为了让我的问题与众不同，让我们添加一个要求，即颜色不能从符号中复制，而是可以设置为任意值。这个增加的要求具有现实世界的相关性，因为我通常为文本使用比符号更深的颜色。

Answer 1

这是一种将 grobs 组合在一起以创造传奇的相当平庸的方法。我根据 drv 的唯一值设置了一个调色板变量(因此它可以缩放到更大的数据集或更多的颜色)。然后我映射调色板的值以制作每个图例项:rectGrob和一个 textGrob ，两者都具有调色板中的相应颜色。这些绝对可以调整以看起来更好。所有这些都被安排成一个新的grob并与cowplot一起卡在情节旁边。 .它并不华丽，但它可能是一个开始。

library(tidyverse)
library(grid)
library(gridExtra)

pal <- colorspace::qualitative_hcl(n = length(unique(drv_counts$drv)), l = 60, c = 70) %>%
  setNames(unique(drv_counts$drv))

p2 <- ggplot(drv_counts, aes(x=model, y=count, fill=drv)) +
  geom_col() + 
  coord_flip() +
  theme_minimal() +
  scale_fill_manual(values = pal, guide = F) +
  theme(axis.text.y = element_text(color = pal[drv_counts$drv]))

legend <- pal %>%
  imap(function(col, grp) {
    rect <- rectGrob(x = 0, width = unit(0.5, "line"), height = unit(0.5, "line"), gp = gpar(col = col, fill = col), hjust = 0)
    label <- textGrob(label = grp, gp = gpar(col = colorspace::darken(col, 0.4), fontsize = 10), x = 0, hjust = 0)
    cowplot::plot_grid(rect, label, nrow = 1, rel_widths = c(0.12, 1))
  }) %>%
  arrangeGrob(grobs = rev(.), padding = unit(0.1, "line"), heights = rep(unit(1.1, "line"), 3))

cowplot::plot_grid(p2, legend, rel_widths = c(1, 0.45))

创建于 2018-05-26 由 reprex package (v0.2.0)。