在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提供一个颜色矢量，但图例标签是在不同的丛林中绘制。

我们可以手动进入并对所有凹凸进行着色，但这非常难看且非常麻烦：

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树，这样我就不必通过手动设置列表索引来访问子窗口，这些索引会改变我对图形进行微小更改的时刻吗？

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

Answer 1

这是一个非常平庸的方法，一起黑客共同制作一个传奇。我根据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))

由reprex package（v0.2.0）创建于2018-05-26。