30  Bump charts

Graphs in this chapter use fmggp2::theme_visor(), built from a green Handspring Visor Deluxe: a pale lavender background, a translucent green frame, a gray LCD panel, green, gray, mint, and silver marks, and a Trebuchet MS title.


Requirements:

✅ a categorical variable

✅ a numeric (continuous) variable

✅ a numeric (date) variable

30.1 Description

Bump charts show how the ranks of different categories (or groups) change over time. Differences are represented with connecting lines (along the y axis) that cover the full timescale (along the x axis).

We can build bump charts in ggplot2 with the ggbump package:

30.2 Set up

PACKAGES:

Install packages.

show/hide 
# pak::pak("davidsjoberg/ggbump")
library(ggbump)
library(ggplot2)
library(dplyr) # for data manipulation
library(tidyr) # for expand_grid()

DATA:

Handspring launched the Visor in 1999, and the Springboard expansion slot on its back turned the handheld into whatever module you slid in. By the end of 2000 there was a modem, a games cartridge, an MP3 player, a GPS receiver, a camera, and the new VisorPhone (which turned the Visor into a cell phone).

We’ll simulate 12 weeks of module sales (the number of units sold across a panel of retailers) for six Springboard modules. Each module gets a weekly average (avg_sales) that rises, falls, or holds steady, and rpois() draws each week’s actual sales around that average. Then we rank the modules within each week (rank), with 1 for the most units sold. Setting the seed with set.seed() means you’ll get the same 72 module weeks every time you run the code below.

show/hide 
set.seed(2000) # same 12 weeks of sales every time the code runs
springboard_sales <- expand_grid(
  week = 1:12, # 12 weeks of sales
  module = c("Modem", "VisorPhone", "Games", # six Springboard modules
             "MP3 Player", "GPS", "Camera") # (every module appears in every week)
  ) |>
  mutate(
    module = factor(module, levels = unique(module)), # keep modules in the order above
    week_of = as.Date("2000-11-04") + 7 * (week - 1), # first day of each week
    avg_sales = case_when( # average weekly sales for each module
      module == "Modem" ~ 420 - 8 * (week - 1), # starts on top, then slowly falls
      module == "VisorPhone" ~ 300 + 15 * (week - 1), # climbs each week
      module == "Games" ~ 330, # holds steady
      module == "MP3 Player" ~ 360 - 5 * (week - 1), # slowly falls
      module == "GPS" ~ 200 + 20 * (week - 1), # starts last, climbs fastest
      module == "Camera" ~ 280 - 10 * (week - 1) # falls each week
      ),
    sales = rpois(n(), lambda = avg_sales) # weekly sales counts around each average
    ) |>
  group_by(week) |> # rank the modules within each week
  mutate(
    rank = rank(-sales, ties.method = "random") # 1 = best seller (ties broken at random)
    ) |>
  ungroup()
glimpse(springboard_sales)
#> Rows: 72
#> Columns: 6
#> $ week      <int> 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, …
#> $ module    <fct> Modem, VisorPhone, Games, MP3 …
#> $ week_of   <date> 2000-11-04, 2000-11-04, 2000-…
#> $ avg_sales <dbl> 420, 300, 330, 360, 200, 280, …
#> $ sales     <int> 402, 295, 361, 377, 183, 255, …
#> $ rank      <int> 1, 4, 3, 2, 6, 5, 1, 4, 3, 2, …

30.3 Distribution

A bump chart throws away the raw numbers and keeps only the order. That makes it easy to see who passed whom, but it also hides how close the race was. When two modules have similar sales, random week to week noise can swap their ranks even though nothing real changed. Below we’ll move from the sales, to a picture, to the formula.

COUNT IT:

Start with the first week.

show/hide 
springboard_sales |>
  filter(week == 1) |>
  select(module, avg_sales, sales, rank) |>
  arrange(rank)

Every module landed within a few dozen units of its average, and the ranks match the order of the averages. Below we count how many times each module changed rank from one week to the next.

show/hide 
rank_changes <- springboard_sales |>
  group_by(module) |>
  summarise(rank_changes = sum(rank != lag(rank), na.rm = TRUE),
            first_rank = first(rank), last_rank = last(rank))
rank_changes

The VisorPhone and GPS climb because their averages climb, and the Modem and Camera slide because theirs slide. But Games changes rank 4 times even though its average never changes.

DRAW IT:

The graph below plots the raw sales for Games and the MP3 Player. The ribbon around each line covers the average plus or minus two standard deviations (more on that below). Wherever the two ribbons overlap, either module could come out ahead in a given week.

show/hide 
two_modules <- springboard_sales |>
  filter(module %in% c("Games", "MP3 Player"))
ggplot(two_modules, aes(x = week_of, color = module, fill = module)) +
  geom_ribbon(aes(ymin = avg_sales - 2 * sqrt(avg_sales),
                  ymax = avg_sales + 2 * sqrt(avg_sales)),
              alpha = 1 / 4, color = NA) +
  geom_line(aes(y = sales), linewidth = 1) +
  geom_point(aes(y = sales), size = 2) +
  scale_color_manual(values = c("Games" = "#808284", "MP3 Player" = "#21786B"),
                     aesthetics = c("color", "fill")) +
  labs(title = "Games and MP3 Player sales",
       subtitle = "Bands show each week's mean plus or minus 2 SD",
       caption = "Simulated data",
       x = "Week of", y = "Units sold", color = "Module", fill = "Module")

The ribbons overlap for all 12 weeks, which is why these two modules trade places in the bump chart.

NAME IT:

Each module’s weekly sales follow a Poisson distribution with its own average for that week (\(\lambda\)):

\[ \text{sales}_{m,w} \sim \text{Poisson}(\lambda_{m,w}) \]

A Poisson count has a standard deviation of \(\sqrt{\lambda}\), so a module averaging 330 units wobbles by about \(\sqrt{330} \approx 18\) units a week. The ribbons above reach twice that (about 36 units) above and below the average. The gap between two modules is approximately normal, with a mean of \(\lambda_1 - \lambda_2\) and a standard deviation of \(\sqrt{\lambda_1 + \lambda_2}\). In week one, the MP3 Player averages 360 units and Games averages 330, so the chance that Games comes out ahead anyway is:

\[ P(\text{swap}) \approx \Phi\left(\frac{-(360 - 330)}{\sqrt{360 + 330}}\right) \approx 0.13 \]

By week seven, both modules average 330 units and the chance is a coin flip (0.5). Rank charts are great for showing who’s on top, but small gaps between ranks are often just Poisson noise. Try making the averages twice as far apart in case_when() and the bump chart gets a lot calmer.

30.4 Grammar

CODE:

  • Create labels with labs()

  • Map week_of to the x, rank to the y, and module to color

  • Add ggbump::geom_bump() and set linewidth to 2

  • Flip the y axis with scale_y_reverse() so rank 1 is on top

  • Set six line colors with scale_color_manual() (the theme’s discrete palette only has four)

  • Label each line at its last week with geom_text(), and make room for the labels with scale_x_date()

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

show/hide 
labs_bump <- labs(title = "Springboard module sales",
  caption = "Simulated data",
  subtitle = "Weekly rank, winter 2000 to 2001",
  x = "Week of", y = "Rank",
  color = "Module")
ggp2_bump <- ggplot(springboard_sales,
    aes(x = week_of,
      y = rank,
      color = module)) +
    ggbump::geom_bump(linewidth = 2) +
    geom_text(data = filter(springboard_sales, week == 12),
      aes(label = module), color = "#3E3F3A",
      hjust = 0, nudge_x = 3) +
    scale_x_date(expand = expansion(mult = c(0.05, 0.2))) +
    scale_y_reverse(breaks = 1:6) +
    scale_color_manual(values = c("#50ADA0", "#21786B", "#808284",
                                  "#3E3F3A", "#B4BBAF", "#5CB8AC")) +
    theme(legend.position = "none")

ggp2_bump +
  labs_bump

GRAPH: