33  Alluvial charts

Graphs in this chapter use fmggp2::theme_y2k(), built from the Y2K countdown: a black terminal background, a red LED frame and title, red, amber, green, silver, and blue screen marks, and a PT Mono title.


Requirements:

✅ multiple categorical variables

✅ a date or time variable

33.1 Description

An alluvial graph displays the changes in composition or flow over time or across multiple categories.

We can build alluvial charts in ggplot2 with the ggalluvial package:.

See also: parallel sets

33.2 Set up

PACKAGES:

Install packages.

show/hide
# pak::pak("corybrunson/ggalluvial")
library(ggalluvial)
library(ggplot2)
library(dplyr) # for data manipulation

DATA:

As 1999 went on, the news filled up with warnings about the Y2K bug: computers that stored years with two digits might think January 1, 2000 was January 1, 1900, and nobody was quite sure what would break. We’ll simulate 300 households surveyed three times in 1999 (January, July, and December) about how prepared they were: "Not worried", "Some supplies" (extra batteries and bottled water), or "Bunker ready".

In January, most households aren’t worried (we draw these with sample()). After that, each household’s next answer depends only on its last answer. The move_probs matrix holds those chances: each row is where a household is now, and each column is where it might be at the next survey.

For example, a household that isn’t worried has a 70% chance of staying that way, a 25% chance of picking up some supplies, and a 5% chance of going all the way to the bunker. The next_survey() function uses sample() to draw each household’s next answer from its row. Setting the seed with set.seed() means you’ll get the same 300 households every time you run the code below.

show/hide
prep_levels <- c("Not worried", "Some supplies", "Bunker ready") # three levels of Y2K preparation
move_probs <- matrix(
  c(0.70, 0.25, 0.05, # from 'Not worried'
    0.15, 0.65, 0.20, # from 'Some supplies'
    0.05, 0.15, 0.80), # from 'Bunker ready'
  nrow = 3, byrow = TRUE, # rows are where a household starts
  dimnames = list(prep_levels, prep_levels) # columns are where it ends up
  )
next_survey <- function(prep) { # moves each household to its next level
  vapply(prep, function(p) {
    sample(prep_levels, size = 1, prob = move_probs[p, ]) # use the row for its current level
  }, character(1), USE.NAMES = FALSE)
}
set.seed(1999) # same 300 households every time the code runs
y2k_households <- tibble(
  household_id = 1:300, # 300 different households, one row each
  jan_1999 = sample(prep_levels,
    size = 300, # one starting level for each household
    replace = TRUE, # levels repeat across households
    prob = c(0.6, 0.3, 0.1) # most households start out 'Not worried'
    )
  ) |>
  mutate(
    jul_1999 = next_survey(jan_1999), # second survey builds on the first
    dec_1999 = next_survey(jul_1999) # third survey builds on the second
    ) |>
  mutate(
    across(-household_id, function(x) factor(x, levels = prep_levels)) # keep the level order
    )
glimpse(y2k_households)
#> Rows: 300
#> Columns: 4
#> $ household_id <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, …
#> $ jan_1999     <fct> Some supplies, Not worried,…
#> $ jul_1999     <fct> Some supplies, Not worried,…
#> $ dec_1999     <fct> Some supplies, Not worried,…

Below we count every combination of the three answers (as y2k_wide). Each row is a path through the three surveys, and freq is how many households took it.

show/hide
y2k_wide <- y2k_households |>
  count(jan_1999, jul_1999, dec_1999, # every path through the three surveys
    name = "freq" # number of households on each path
    )
glimpse(y2k_wide)
#> Rows: 22
#> Columns: 4
#> $ jan_1999 <fct> Not worried, Not worried, Not w…
#> $ jul_1999 <fct> Not worried, Not worried, Not w…
#> $ dec_1999 <fct> Not worried, Some supplies, Bun…
#> $ freq     <int> 83, 25, 3, 7, 29, 9, 1, 6, 7, 5…

33.3 Distribution

An alluvial chart shows how things move between categories. The width of each flow is a count, and the counts come from a chain of random moves: every household rolls the dice at every survey. Below we’ll move from the households, to a picture, to the formula.

COUNT IT:

Start with the first five households.

show/hide
head(y2k_households, 5)

Some households stay put and some move. Below we cross January’s answers (rows) with July’s answers (columns) using table().

show/hide
jan_jul <- table(January = y2k_households$jan_1999,
                 July = y2k_households$jul_1999)
jan_jul
#>                July
#> January         Not worried Some supplies
#>   Not worried           111            45
#>   Some supplies          13            64
#>   Bunker ready            0            10
#>                July
#> January         Bunker ready
#>   Not worried              7
#>   Some supplies           23
#>   Bunker ready            27

Of the 163 households that weren’t worried in January, 111 still weren’t worried in July. That’s about 68%, close to the 70% in the first row of move_probs.

DRAW IT:

The alluvial chart below draws the same table. Each cell in jan_jul that isn’t 0 becomes a flow from January to July, and the width of the flow is the count in that cell. That’s 8 of the nine cells, because no household went from "Bunker ready" to "Not worried".

show/hide
y2k_households |>
  count(jan_1999, jul_1999, name = "freq") |>
  ggplot(aes(axis1 = jan_1999, axis2 = jul_1999, y = freq)) +
  scale_x_discrete(limits = c("Jan 1999", "Jul 1999"),
                   expand = c(0.1, 0.07)) +
  geom_alluvium(aes(fill = jan_1999)) +
  geom_stratum() +
  geom_text(stat = "stratum", aes(label = after_stat(stratum)), size = 3) +
  labs(y = "Households") +
  theme(legend.position = "none")
#> Warning in to_lodes_form(data = data, axes =
#> axis_ind, discern = params$discern): Some strata
#> appear at multiple axes.
#> Warning in to_lodes_form(data = data, axes =
#> axis_ind, discern = params$discern): Some strata
#> appear at multiple axes.
#> Warning in to_lodes_form(data = data, axes =
#> axis_ind, discern = params$discern): Some strata
#> appear at multiple axes.

The large numbers on the diagonal of move_probs make staying put the most likely move, but the width of a flow also depends on how many households start in that category. That’s why the flow from "Not worried" to "Some supplies" (45 households) is wider than the flow of households that stay "Bunker ready" (27).

NAME IT:

A process where the next step depends only on the current step is a Markov chain. The households in each starting category split across the three categories according to a multinomial distribution (the same distribution we used for the last Alleyway stage each player reached in Chapter 1), with probabilities from that category’s row of move_probs:

\[ (N_{\text{not}}, N_{\text{some}}, N_{\text{bunker}}) \mid \text{Not worried} \sim \text{Multinomial}\left(n_{\text{not}}, \; (0.70, 0.25, 0.05)\right) \]

Multiplying January’s counts by the matrix gives the counts we’d expect in July:

show/hide
expected_jul <- as.vector(table(y2k_households$jan_1999)) %*% move_probs
rbind(expected = round(expected_jul[1, ], 1),
      observed = table(y2k_households$jul_1999))
#>          Not worried Some supplies Bunker ready
#> expected       130.9         111.3         57.8
#> observed       124.0         119.0         57.0

The observed July counts land close to the expected ones. Because the off diagonal chances of moving toward the bunker (0.25 and 0.20) are bigger than the chances of moving back (0.15 and 0.15), each survey pushes more households toward the right side of the matrix. Try changing the first row of move_probs to c(0.95, 0.04, 0.01) and most of the flows stay flat.

33.4 Grammar

CODE:

  • Create labels with labs() and ylab()

  • Add scale_x_discrete() with the limits set to "Jan 1999", "Jul 1999" and "Dec 1999", and expand to 0.1 and 0.07

  • Add geom_alluvium() with fill set to the jan_1999 variable and geom_stratum()

  • Add geom_text(), with stat set to stratum and label set to after_stat(stratum) (inside aes())

  • Remove the legend with theme(legend.position = "none") (the labels on the strata already name each category)

show/hide
labs_alluvial <- labs(title = "Y2K prep",
    caption = "Simulated data",
    subtitle = "300 households surveyed three times in 1999")
labs_alluvial_y <- ylab("Households")

ggp2_alluvial_w <- ggplot(data = y2k_wide,
  aes(axis1 = jan_1999, axis2 = jul_1999,
      axis3 = dec_1999, y = freq)) +
  scale_x_discrete(
    limits = c("Jan 1999", "Jul 1999", "Dec 1999"),
    expand = c(0.1, 0.07)) +
  geom_alluvium(aes(fill = jan_1999)) +
  geom_stratum() +
  geom_text(stat = "stratum",
    aes(label = after_stat(stratum)),
      size = 3)

ggp2_alluvial_w +
  theme(legend.position = "none") +
  labs_alluvial +
  labs_alluvial_y

GRAPH:

The ggalluvial functions can handle wide or long data.

33.5 More info

The ggalluvial package can also help reshape data with the to_lodes_form() function.

33.5.1 to_lodes_form()

Below we create y2k_lodes from the y2k_wide data using the to_lodes_form() from the ggalluvial package. We’ll keep a copy of each household’s January answer (January) so we can still use it for fill after the reshaping.

show/hide
y2k_lodes <- y2k_wide |>
  rename(`Jan 1999` = jan_1999, `Jul 1999` = jul_1999, # readable axis labels
         `Dec 1999` = dec_1999, Households = freq) |>
  mutate(January = `Jan 1999`) |> # keep each household's starting level for fill
  ggalluvial::to_lodes_form(
    key = "Survey", # new column holding the survey names
    axes = 1:3 # the three survey columns become the axes
    )
glimpse(y2k_lodes)
#> Rows: 66
#> Columns: 5
#> $ Households <int> 83, 25, 3, 7, 29, 9, 1, 6, 7,…
#> $ January    <fct> Not worried, Not worried, Not…
#> $ alluvium   <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10…
#> $ Survey     <fct> Jan 1999, Jan 1999, Jan 1999,…
#> $ stratum    <fct> Not worried, Not worried, Not…

Create labels with labs()

  • Map Survey to x, Households to y, stratum to stratum, alluvium to alluvium, and label to stratum.

  • Add the geom_alluvium() and map January to fill

  • Add the geom_stratum() and set the width to 0.45

  • Add geom_text() and set stat to "stratum" and size to 3.5

  • Remove the legend with theme(legend.position = "none")

show/hide
labs_alluvial <- labs(title = "Y2K prep",
    caption = "Simulated data",
    subtitle = "300 households surveyed three times in 1999")

ggp2_alluvial_lf <- ggplot(
    data = y2k_lodes,
    aes(x = Survey,
        y = Households,
        stratum = stratum,
        alluvium = alluvium,
        label = stratum)) +
    ggalluvial::geom_alluvium(aes(fill = January)) +
    ggalluvial::geom_stratum(width = 0.45) +
    geom_text(stat = "stratum", size = 3.5)

ggp2_alluvial_lf +
    labs_alluvial +
    theme(legend.position = "none")

33.5.2 geom_flow()

If you’d like to arrange the date or time variable across the x, you can use the ggalluvial::geom_flow() with ggalluvial::geom_stratum().

  • First create y2k_long, a long version of y2k_households with one row per household per survey (and survey as a factor in the order the surveys happened).
show/hide
y2k_long <- y2k_households |>
  tidyr::pivot_longer(
    cols = -household_id, # stack the three survey columns
    names_to = "survey", # which survey each row comes from
    values_to = "prep" # the household's level in that survey
    ) |>
  mutate(
    survey = factor(survey,
      levels = c("jan_1999", "jul_1999", "dec_1999"), # surveys in time order
      labels = c("Jan 1999", "Jul 1999", "Dec 1999") # readable labels
      ),
    household_id = factor(household_id) # each household is a category
    )
glimpse(y2k_long)
#> Rows: 900
#> Columns: 3
#> $ household_id <fct> 1, 1, 1, 2, 2, 2, 3, 3, 3, …
#> $ survey       <fct> Jan 1999, Jul 1999, Dec 199…
#> $ prep         <fct> Some supplies, Some supplie…
  • Create labels with labs()

  • Initiate graph with data

  • Map the survey to the x, prep to stratum, household_id to alluvium, prep to fill, and prep to label.

  • Add the geom_flow(), with stat set to "alluvium" and lode.guidance set to "frontback" (with 300 households, each flow is only one household wide, so we leave the outline color off or it covers the fill)

show/hide
# labels
labs_alluvial <- labs(
  title = "Y2K prep across three surveys",
  caption = "Simulated data",
  x = "Survey", y = "Households",
  fill = "Prep")
# add geom_flow()
ggp2_alluvial_flow <- ggplot(data = y2k_long,
  mapping = aes(x = survey, stratum = prep,
    alluvium = household_id,
    fill = prep, label = prep)) +
  geom_flow(stat = "alluvium",
    lode.guidance = "frontback")

ggp2_alluvial_flow +
  labs_alluvial

  • Add ggalluvial::geom_stratum()
show/hide
# add geom_stratum()
ggp2_alluvial_stratum <- ggp2_alluvial_flow +
  geom_stratum()
ggp2_alluvial_stratum +
  labs_alluvial

33.5.3 legend.position

Move legend to bottom with theme(legend.position = "bottom")

show/hide
ggp2_alluvial_stratum +
  labs_alluvial +
  theme(legend.position = "bottom")