为堆积条形图的两个维度设置颜色

Question

我想制作一个堆叠条形图，显示每周的目标进度，其中堆叠的颜色不同，堆叠中的每个项目都是堆叠颜色的不同深浅。

准备：

library(tidyverse)
library(RColorBrewer)
    
teams <- data.frame(
    team = factor(LETTERS[1:6], levels = rev(LETTERS[1:6]), ordered = T),
    goal = c(200, 160, 200, 250, 220, 180))

weeks <- teams %>%
    slice(rep(1:n(), each = 3)) %>%
    mutate(week = factor(rep(c(1:3), 6), levels = c(3:1), ordered = T),
           alph =  1 - 0.1 * as.numeric(week),
           value = c(40, 55, 54, 34, 36, 34, 31, 46, 46, 59, 63, 67, 31, 54, 52, 38, 46, 44),
           week_progress = value / goal) 

teams <- teams %>% 
    inner_join(weeks %>% group_by(team) %>% summarise(progress = sum(value)), by = 'team') %>% 
    mutate(team_progress = progress / goal)

我可以绘制整体进度并且默认颜色效果很好：

ggplot(teams, aes(x = team_progress, y = team, fill = team)) +
    geom_bar(stat = 'identity', color = 'black', show.legend = FALSE) +
    geom_text(aes(label = scales::percent_format(accuracy = 0.1)(team_progress), 
              x = team_progress + 0.01), hjust = 0)

我可以使用 alpha 值接近我想要的每周情节：

ggplot(weeks, aes(x = week_progress, y = team, fill = team)) +
    geom_bar(aes(alpha = alph), stat = 'identity', position = position_stack(), color = 'black', show.legend = F) +
    geom_text(aes(group = week, label = scales::percent_format(accuracy = 0.1)(week_progress), x = week_progress), 
              position = position_stack(vjust = 0.5), color = 'blue')

pal <- c(brewer.pal(9, 'YlOrRd')[4:6],
         brewer.pal(9, 'YlGnBu')[4:6],
         brewer.pal(9, 'RdPu')[4:6],
         brewer.pal(9, 'PuBuGn')[4:6],
         brewer.pal(9, 'Greens')[4:6],
         brewer.pal(9, 'BrBG')[4:2]
)

我的问题是：

1. 我将 alpha 值设置为 07、0.8、0.9，但绘制的值看起来更接近 0.1、0.4、1.0。我该如何解决这个问题？
2. 如果我有 18 种颜色的调色板（以上 3 周 x 6 支团队），我将如何将其应用于堆栈？

Answer 1

这可以这样实现：

1. alpha 的问题在于您将 alph 映射到 alpha。但是，alpha 的值由 ggplot 选择。要设置特定的 alpha 值，您可以例如将week 映射到alpha 并使用scale_alpha_manual 设置alpha 值。

2. 要添加颜色，请将颜色作为列添加到数据中，将此列映射到 fill 并使用 scale_fill_identity。

library(tidyverse)

teams <- data.frame(
  team = factor(LETTERS[1:6], levels = rev(LETTERS[1:6]), ordered = T),
  goal = c(200, 160, 200, 250, 220, 180))

weeks <- teams %>%
  slice(rep(1:n(), each = 3)) %>%
  mutate(week = factor(rep(c(1:3), 6), levels = c(3:1), ordered = T),
         alph =  1 - 0.1 * as.numeric(week),
         value = c(40, 55, 54, 34, 36, 34, 31, 46, 46, 59, 63, 67, 31, 54, 52, 38, 46, 44),
         week_progress = value / goal) 

teams <- teams %>% 
  inner_join(weeks %>% group_by(team) %>% summarise(progress = sum(value)), by = 'team') %>% 
  mutate(team_progress = progress / goal)
#> `summarise()` ungrouping output (override with `.groups` argument)

ggplot(weeks, aes(x = week_progress, y = team, fill = team)) +
  geom_bar(aes(alpha = week), stat = 'identity', position = position_stack(), color = 'black', show.legend = F) +
  scale_alpha_manual(values = c(`1` = 0.7, `2` = 0.8, `3` = 0.9)) +
  geom_text(aes(group = week, label = scales::percent_format(accuracy = 0.1)(week_progress), x = week_progress), 
            position = position_stack(vjust = 0.5), color = 'blue')

library(RColorBrewer)

pal <- c(brewer.pal(9, 'YlOrRd')[4:6], brewer.pal(9, 'YlGnBu')[4:6], brewer.pal(9, 'RdPu')[4:6], brewer.pal(9, 'PuBuGn')[4:6], brewer.pal(9, 'Greens')[4:6], brewer.pal(9, 'BrBG')[4:2] )

weeks <- mutate(weeks, cols = pal)

ggplot(weeks, aes(x = week_progress, y = team, fill = cols)) +
  geom_bar(stat = 'identity', position = position_stack(), color = 'black', show.legend = F) +
  scale_fill_identity() +
  geom_text(aes(group = week, label = scales::percent_format(accuracy = 0.1)(week_progress), x = week_progress), 
            position = position_stack(vjust = 0.5), color = 'blue')