Блог

Я хочу создать сложенную линейку, показывающую еженедельный прогресс в достижении цели, где стеки имеют разные цвета, а каждый элемент в стеке имеет другой оттенок цвета стека.

Подготовка:

 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)
  

Я могу приблизиться к тому, что я хочу для еженедельного графика, используя альфа-значения:

 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. Я устанавливаю альфа-значения на 07, 0.8, 0.9, но отображаемые значения выглядят ближе к 0.1, 0.4, 1.0. Как мне это исправить?
2. Если бы у меня была палитра из 18 цветов (3 недели x 6 команд, выше), как бы я применил это к стекам?

Это может быть достигнуто следующим образом:

1. Проблема с alpha заключается в том, что вы сопоставили alphh на alpha . Однако значения для alpha выбираются ggplot. Чтобы задать конкретные значения альфа, вы можете, например, отобразить week на alpha и использовать scale_alpha_manual для установки значений альфа.

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