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)
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]
)
My questions are:
This could be achieved like so:
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.
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')