Update alluvial plots to ggalluvial

[nsbatra]

Data begins in linelist format, with each row having a classification. Then transformed to "wide" with one column per time (values the classifications), plus one column for counts. Then transformed to long with ggalluvial-specific function.

Data preparation:

ELR_wide <- ELR %>% 
  pivot_wider(
    id_cols = c(country, who_region),
    names_from = week,
    values_from = final) %>% 
  drop_na() %>% 
  group_by(across(contains("2021"))) %>% 
  count() %>% 
  ungroup() %>% 
  mutate(across(.cols = -n, 
                .fns = ~recode(.x,
                              "1 - Critical" = "Critical",
                              "2 - Very high" = "Very high", 
                              "3 - High" = "High",
                              "4 - Medium" = "Medium",
                              "5 - Low" = "Low",
                              "6 - Minimal/NA" = "Minimal",
                              "No Data" = "No Data"))) %>% 
  mutate(across(.cols = -n,
                .fns = ~fct_relevel(.x, c(
                  "Critical",
                  "Very high", 
                  "High",
                  "Medium",
                  "Low",
                  "Minimal",
                  "No Data")))) %>% 
  mutate(across(.cols = -n,
                .fns = fct_rev))

#levels(ELR_wide$`2021-07-19`)

library(ggalluvial)
#is_alluvia_form(as.data.frame(ELR_wide), axes = 1:3, silent = TRUE)

ELR_long_alluvial_original <- to_lodes_form(data.frame(ELR_wide),
                              key = "date",
                              axes = 1:6) %>% 
  mutate(date = str_replace_all(date, "X2021.", "")) %>% 
  mutate(stratum = fct_relevel(stratum,
                                    c("Critical",
                                      "Very high", 
                                      "High",
                                      "Medium",
                                      "Low",
                                      "Minimal",
                                      "No Data")))

# add current ELR classifications
ELR_long_alluvial <- left_join(
  ELR_long_alluvial_original,
  ELR_long_alluvial_original %>%
              select(-n) %>% 
              filter(date == max(date, na.rm=T)) %>% 
              rename(
                current_date = date,
                current_ELR = stratum),
            by = c("alluvium" )) 

# add earliest ELR classifications
ELR_long_alluvial <- left_join(
  ELR_long_alluvial,
  ELR_long_alluvial_original %>%
              select(-n) %>% 
              filter(date == min(date, na.rm=T)) %>% 
              rename(
                oldest_date = date,
                oldest_ELR = stratum),
            by = c("alluvium" )) 

data visualization with ggalluvial

# plot showing current classification
ggplot(data = ELR_long_alluvial,
       aes(x = date, stratum = stratum, alluvium = alluvium,
           y = n, label = stratum)) +
  geom_alluvium(aes(fill = current_ELR)) +
  geom_stratum() +
  geom_text(stat = "stratum", size = 1) +
  theme_minimal() +
  scale_fill_manual(
    values = c(
      "Critical" = "black",
      "Very high" = "darkred",
      "High" = "red",
      "Medium" = "darkorange",
      "Low" = "darkgreen",
      "Minimal" = "green",
      "No Data" = "grey"))+
  labs(
    title = "[INTERNAL] ELR classification trajectories\ncolored by current classification (global)",
    fill = str_glue("ELR classification\non {max(ELR_long_alluvial$date, na.rm=T)}"),
    caption = "Last 6 weeks of data")

[aspina7]

see https://github.com/R4EPI/sitrep/pull/275/commits/fc9e04b48e10f8c2e8cb6a72067d2e221303d611 for r4epis mortality template implementation

[jarvisc1]

Close old issue

[jarvisc1]

Reopened and assigned to @arranhamlet

[arranhamlet]

This has been updated in the latest version of the handbook