对于 ggplot2 图例键，添加与其他美学颜色匹配的边框，不填充答案

【问题标题】：For ggplot2 legend key, add border that matches color of other aesthetics with not fill对于 ggplot2 图例键，添加与其他美学颜色匹配的边框，不填充
【发布时间】：2021-02-15 13:33:33
【问题描述】：

我正在做一个使用颜色、填充、形状和线型美学的 ggplot。我希望图例键没有填充，但我希望图例键边框的颜色与图例中其他美学的颜色相匹配。下图中的所有内容都是我想要的，除了边框。

请告诉我如何使每个键的边框颜色与其余键的颜色相匹配（即 A 的边框为灰色，B 为黄色，C 为蓝色，D 为是绿色的）。

library(tidyverse)

# Create sample data
set.seed(1)
dat <- data.frame(var_a = rnorm(20), 
                  var_b = rep(c('A', 'B', 'C', 'D'), 5)) %>%
  mutate(response = case_when(var_b == 'A' ~ var_a + 1,
                              var_b == 'B' ~ var_a * 2,
                              var_b == 'C' ~ var_a * .5,
                              var_b == 'D' ~ 1)) %>%
  mutate(response = response + rnorm(nrow(.), 0, 0.1))



# Map colors to values of var_b
custom_color <- c('A' = "#999999", 'B' = "#F0E442", 
                    'C' = "#56B4E9", 'D' = "#009E73")

# Create custom theme
my_theme <- theme_bw() +
  theme(legend.position = 'top',
        legend.key.width = unit(0.35, 'in'))

# Create list with theme and manual aesthetic assignment
my_theme_list <- list(my_theme, 
                      scale_color_manual(values = custom_color),
                      scale_fill_manual(values = custom_color))

# Plot
plot_1 <- dat %>% ggplot(aes(x = var_a, y = response, color = var_b, shape = var_b,
                   linetype = var_b, fill = var_b)) +
  geom_point() +
  geom_smooth(method = 'lm') +
  my_theme_list +
  guides(shape = guide_legend(override.aes = list(fill = NA))) +
  # Here's the part that's not working
  theme(legend.key = element_rect(color = custom_color))

plot_1

# Somehow plot(ggeffect()) is able to color the legend key boxes, but I can't
#  figure out how it does it
library(ggeffect)
mod <- lm(response ~ var_a * var_b, data = dat)

plot(ggeffect(mod, c('var_a', 'var_b'))

【问题讨论】：

我认为你想要达到的目标不会给情节带来任何额外的信息。颜色已经在每个图例框中表示为一条线。由于颜色和填充采用相同的颜色模式，因此图例完全解释了该图。就美学而言，你的情节看起来也不错（在我看来）..
@rodolfoksveiga - 我同意，但我正在为不想使用颜色的人制作类似的情节，以防情节被黑白复制。这似乎是一个过时的政策，但我试图提供他们所要求的。感谢您的评论。

标签： r ggplot2 legend

【解决方案1】：

问题是，通过theme，您可以在按键周围绘制边框，但据我所知，您不能为按键设置不同的边框颜色。实现所需结果的一种方法是使用自定义键字形，它将geom_point 的默认点字形 (draw_key_point) 与矩形字形 (draw_key_rect) 相结合：

library(tidyverse)

# Create sample data
set.seed(1)
dat <- data.frame(var_a = rnorm(20), 
                  var_b = rep(c('A', 'B', 'C', 'D'), 5)) %>%
  mutate(response = case_when(var_b == 'A' ~ var_a + 1,
                              var_b == 'B' ~ var_a * 2,
                              var_b == 'C' ~ var_a * .5,
                              var_b == 'D' ~ 1)) %>%
  mutate(response = response + rnorm(nrow(.), 0, 0.1))



# Map colors to values of var_b
custom_color <- c('A' = "#999999", 'B' = "#F0E442", 
                  'C' = "#56B4E9", 'D' = "#009E73")

# Create custom theme
my_theme <- theme_bw() +
  theme(legend.position = 'top',
        legend.key.width = unit(0.35, 'in'))

# Create list with theme and manual aesthetic assignment
my_theme_list <- list(my_theme, 
                      scale_color_manual(values = custom_color),
                      scale_fill_manual(values = custom_color))

# Plot
draw_key_cust <- function(data, params, size) {
  grid::grobTree(
    grid::rectGrob(gp = grid::gpar(
      col = data$colour, 
      fill = data$fill, 
      lty = data$linetype)),
    grid::pointsGrob(0.5, 0.5, 
                     pch = data$shape,
                     gp = grid::gpar(
                       col = data$colour,
                       fill = data$fill,
                       fontsize = data$size * .pt))
  )
}

plot_1 <- dat %>% ggplot(aes(x = var_a, y = response, color = var_b, shape = var_b,
                             linetype = var_b, fill = var_b)) +
  geom_point(key_glyph = "cust") +
  geom_smooth(method = 'lm') +
  my_theme_list +
  guides(shape = guide_legend(override.aes = list(fill = NA)))

plot_1
#> `geom_smooth()` using formula 'y ~ x'

【讨论】：

我认为这是 Stefan 两种解决方案中不那么 hacky 的一个 - 如果我正在制作一个包，我会使用这样的东西。它也比我想象的要简洁。可惜我只能投票一次！
Allan 和 Stefan，非常感谢您的回答。他们都工作得很好。我同意 Stefan 的更简洁，我开始弄清楚它是如何工作的。里面几乎所有的东西对我来说都是新的，而且非常令人印象深刻。如果有人感兴趣，我已将 ggeffect() 的代码添加到我的问题中的代码中。不知何故，它能够为我想要的颜色框着色，但我无法弄清楚它是如何做到的。

【解决方案2】：

正如 Stefan 所指出的，这个参数不是矢量化的。

编写扩展的替代方法是渲染绘图并修改构造它的 grobs：

plot_2 <- ggplotGrob(plot_1)
legend <- which(plot_2$layout$name == "guide-box")
guides <-  which(plot_2$grobs[[legend]]$layout$name == "guides")
bgs    <- grep("bg", plot_2$grobs[[legend]]$grobs[[guides]]$layout$name)
box_grobs <- plot_2$grobs[[legend]]$grobs[[guides]]$grobs[bgs]

plot_2$grobs[[legend]]$grobs[[guides]]$grobs[bgs] <- mapply( function(x, y) {
  x$gp$col <- y; x
  }, box_grobs, custom_color, SIMPLIFY = FALSE)

grid::grid.draw(plot_2)

【讨论】：