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

我的问题是:有人可以想到一种方法来获得这种效果,而不必深入挖掘grob树吗？如果ggplot2只有几条修改过的行,我可以使用ggplot2补丁.或者,可以自动挖掘到grob树,因此我不必通过手动设置列表索引来访问子窗口,这将改变我对图形进行微小更改的时刻吗？

更新:可以在此处找到相关问题.为了使我的问题与众不同,让我们添加一个要求,即颜色不会从符号中复制出来,而是可以设置为任意值.这个增加的要求具有真实世界的相关性,因为我通常使用较暗的颜色来表示文本而不是符号.

Answer 1

这是一个相当平庸的方法，可以将一群人拼凑在一起创造一个传奇。我根据drv变量的唯一值设置一个调色板（因此可以缩放到更大的数据集或更多颜色）。然后，我映射调色板的值以制作每个图例项： arectGrob和 a 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))

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