Эффективный способ сопоставить данные с цветом текста легенды в 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))

Причина, по которой это не работает для текста легенды, но работает для текста оси, заключается в том, что все метки оси нарисованы в одном элементе цветопередачи, и, следовательно, мы можем присвоить этому элементу цветовой вектор, а метки условных обозначений нарисованы в виде отдельных элементов.

Мы можем закрасить все гробы вручную, но это очень уродливо и громоздко:

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, если это всего лишь несколько модифицированных строк. Или же можно ли автоматизировать копание в дереве гробов, чтобы мне не приходилось обращаться к дочерним гробам вручную, устанавливая индексы списков, которые изменятся, как только я внесу незначительные изменения в фигуру?

Обновление: связанный вопрос может быть найден здесь. Чтобы сделать мой вопрос четким, давайте добавим требование, чтобы цвета не копировались из символов, а могли быть установлены на любые произвольные значения. Это добавленное требование имеет отношение к реальной жизни, потому что я обычно использую более темный цвет для текста, чем для символов.

Answer 1

Вот довольно посредственный метод взлома гробов, чтобы создать легенду. Я устанавливаю палитру на основе уникальных значений drv переменная (так что ее можно масштабировать до больших наборов данных или нескольких цветов). Затем я сопоставил значения палитры, чтобы сделать каждый элемент легенды: rectGrob и textGrobкак с соответствующим цветом из палитры. Это определенно можно настроить, чтобы выглядеть лучше. Все они организованы в новый гроб и застряли рядом с сюжетом с 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 пакетом представлением (v0.2.0).