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

Question

我正在做一个 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'))

Answer 1

问题是通过 theme您可以在按键周围绘制边框，但据我所知，您不能为按键设置不同的边框颜色。实现所需结果的一种方法是使用自定义键字形，它结合了 draw_key_point 的默认点字形 ( geom_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'