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

编程问答 2022-06-20

问题描述

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

预备：

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),alph =  1 - 0.1 * as.numeric(week),value = c(40,55,54,34,36,31,46,59,63,67,52,38,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)

Team overall progress

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

ggplot(weeks,aes(x = week_progress,fill = team)) +
    geom_bar(aes(alpha = alph),stat = 'identity',position = position_stack(),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],'RdPu')[4:6],'PuBuGn')[4:6],'Greens')[4:6],'BrBG')[4:2]
)

Weekly progress

我的问题是：

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

解决方法

可以这样实现：

  1. alpha的问题是您在alpha上映射了Alph。但是，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),alph =  1 - 0.1 * as.numeric(week),value = c(40,55,54,34,36,31,46,59,63,67,52,38,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],'RdPu')[4:6],'PuBuGn')[4:6],'Greens')[4:6],'BrBG')[4:2] )

weeks <- mutate(weeks,cols = pal)

ggplot(weeks,fill = cols)) +
  geom_bar(stat = 'identity',show.legend = F) +
  scale_fill_identity() +
  geom_text(aes(group = week,color = 'blue')

colorsgeom-barggplot2rr