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

如何解决对于ggplot2图例键，添加与其他美学颜色匹配且不填充的边框

我正在做一个使用颜色，填充，形状和线型美学的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.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'))

解决方法

问题在于，您可以通过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.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,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指出的那样，该参数未矢量化。

编写扩展名的另一种方法是渲染图并修改从中构建图的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)