Search code examples
rggplot2colorsgeom-bar

Set colours for both dimensions of a stacked bar plot


I want to produce a stacked bar showing weekly progress towards a goal, where the stacks are different colours and each item in the stack is a different shade of the stack's colour.

Prep:

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)

I can plot the overall progress and the default colours work well:

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

I can get close to what I want for the weekly plot using alpha values:

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]
)

Weekly progress

My questions are:

  1. I'm setting the alpha values to 07, 0.8, 0.9, but the values being plotted look to be closer to 0.1, 0.4, 1.0. How do I fix this?
  2. If I had a palette of 18 colours (3 weeks x 6 teams, above), how would I apply this to the stacks?

Solution

  • This could be achieved like so:

    1. The issue with the alpha is that you mapped alph on alpha. However, the values for alpha are chosen by ggplot. To set specific alpha values you can e.g. map week on alpha and use scale_alpha_manual to set the alpha values.

    2. To add your colors add the colors as a column to your data, map this column on fill and make use of 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')