14  Diverging bar graphs

TipTheme: theme_orbitz()

Graphs in this chapter use fmggp2::theme_orbitz(), built from Orbitz, the 1997 drink with floating balls: a black background, a gold frame, gold and magenta ball marks, sand, maroon, and amber accents, and a Marker Felt title.

Requirements:

✅ a categorical variable

✅ a numeric (continuous) variable

14.1 Description

A diverging bar graph shows two groups as bars that start at the same line and point away from each other. If you have two shares of a whole¹ with values above and below 0,² try diverging bars with geom_bar().

In most bar graphs, every bar starts at the same line and goes the same way.³ In a diverging bar graph, numbers above 0 go one way from a center line, and numbers below 0 go the other way.⁴ We use the color of each bar, how long it is, and where it is to compare the numbers across groups (and within each group).⁵

14.1.1 Vertical bars

Orbitz was a drink with small balls of many colors in it. For example, we can use how long each bar is from the center line to compare the share for Orbitz across all weeks (that is, compare the bars below the line to each other).⁶

14.1.2 Horizontal bars

Surge was another drink that kids bought in the same years. We can also compare Surge and Orbitz within each week (that is, compare the gold bar to the right of the line and the bar to the left of it within each week).⁷

14.2 Set up

PACKAGES:

Bring in the code we’ll use.⁸

library(ggplot2)
library(dplyr) # for data manipulation
library(tidyr) # for uncount()

DATA:

Orbitz came to stores in 1997, with small balls of many colors that stayed up in the middle of a clear drink.⁹ Kids bought it once to see the balls, and then most of them went back to Surge. We’ll make up¹⁰ the answers of 400 kids at school each week, for the seven weeks after Orbitz came out.¹¹ Each week we ask every kid which drink they bought that week: Surge, Orbitz, or something else (Other).

The chance that a kid picks Surge grows each week as Orbitz stops feeling new (p_surge).¹² Orbitz gets what’s left of 80% (p_orbitz), and Other stays at 20%. For each kid, runif() picks a number between 0 and 1,¹³ and case_when() turns that number into a drink, using the chances for that week.¹⁴ Then we keep Surge and Orbitz, work out the share of the 400 kids for each one, and turn the Orbitz share below 0 so its bar points down.¹⁵ Starting with set.seed()¹⁶ means you’ll get the same 2,800 answers every time you run the code below.

set.seed(1993) # same survey answers every time the code runs
lunchroom_survey <- tibble(week = 1:7) |> # seven weeks of surveys
  mutate(
    p_surge = 0.8 * plogis(-2 + 0.6 * (week - 1)), # Surge's share climbs each week
    p_orbitz = 0.8 - p_surge # Orbitz gets the rest of the 80% (the other 20% pick something else)
    ) |>
  tidyr::uncount(400, .id = "kid") |> # 400 kids answer each week
  mutate(
    u = runif(n()), # a random number between 0 and 1 for each kid
    choice = case_when(
      u < p_surge ~ "Surge", # below Surge's share
      u < p_surge + p_orbitz ~ "Orbitz", # inside Orbitz's share
      TRUE ~ "Other" # everything else
      )
    ) |>
  select(week, kid, choice)
orbitz_diverg <- lunchroom_survey |>
  filter(choice != "Other") |> # keep only the two drinks
  count(week, choice) |> # kids picking each drink each week
  mutate(
    share = n / 400, # share of all 400 kids
    share = if_else(choice == "Orbitz", -share, share), # Orbitz bars point down
    choice = factor(choice, levels = c("Surge", "Orbitz")),
    week = factor(week) # each week is a category
    )
glimpse(orbitz_diverg)
#> Rows: 14
#> Columns: 4
#> $ week   <fct> 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, …
#> $ choice <fct> Orbitz, Surge, Orbitz, Surge, Orb…
#> $ n      <int> 275, 30, 244, 65, 219, 94, 181, 1…
#> $ share  <dbl> -0.6875, 0.0750, -0.6100, 0.1625,…

14.3 Distribution

A diverging bar graph puts two shares back to back, so the question it answers is “how do these two groups trade places?” Here, every kid picks just one drink each week, so anything Surge wins has to come from some other place. Below we’ll move from the kids, to a graph, to the rule behind it.¹⁷

COUNT IT:

Start with the first ten kids we asked in week 1.

head(lunchroom_survey$choice, 10)
#>  [1] "Orbitz" "Surge"  "Orbitz" "Orbitz" "Orbitz"
#>  [6] "Orbitz" "Orbitz" "Orbitz" "Other"  "Surge"

Seven of these ten kids bought Orbitz, two bought Surge, and one bought something else. When we add up every kid in every week, we see the trade: the number for Orbitz falls each week while the number for Surge goes up, and Other stays between about 60 and 100.

lunchroom_survey |>
  count(week, choice) |>
  tidyr::pivot_wider(names_from = choice, values_from = n)

DRAW IT:

A bar model shows the 400 kids in each week as one bar cut into three parts.¹⁸ As we read up from week 1, the Surge part grows, the Orbitz part gets smaller, and the Other part moves very little.

lunchroom_survey |>
  count(week, choice) |>
  mutate(choice = factor(choice,
    levels = c("Surge", "Orbitz", "Other"))) |>
  ggplot(aes(x = n, y = factor(week), fill = choice)) +
  geom_col(position = position_stack(reverse = TRUE)) +
  labs(x = "Kids", y = "Week", fill = "Drink")

The diverging bar graph below takes the Surge and Orbitz parts of each bar and points them away from each other, starting at 0. The points show the shares we put into the rule when we made up the data.¹⁹ The two bars are just as long as each other at some point between weeks 4 and 5, which is where the two drinks traded places.

expected_shares <- tibble(week = 1:7) |>
  mutate(Surge = 0.8 * plogis(-2 + 0.6 * (week - 1)),
         Orbitz = -(0.8 - Surge),
         week = factor(week)) |>
  tidyr::pivot_longer(-week, names_to = "choice", values_to = "share")

ggplot(data = orbitz_diverg, aes(x = week, y = share)) +
  geom_bar(aes(fill = choice), stat = "identity", width = .5) +
  geom_point(data = expected_shares, size = 2.5) +
  geom_hline(yintercept = 0) +
  scale_y_continuous(limits = c(-1, 1), labels = scales::percent) +
  labs(x = "Week", y = "Share of kids", fill = "Drink")

NAME IT:

Each kid’s answer is one pick from three choices, so the numbers for each week follow a rule for how many picks land in each of a few groups:²⁰

\[ (N_{\text{Surge}}, N_{\text{Orbitz}}, N_{\text{Other}}) \sim \text{Multinomial}\left(400, \; (p_t, \; 0.8 - p_t, \; 0.2)\right) \]

\[ p_t = 0.8 \times \text{logistic}\left(-2 + 0.6\,(t - 1)\right) \]

The rule in plogis()²¹ makes the share for Surge go up a little at first, fastest in the middle, and then it levels off. Surge and Orbitz share the same 80%, so their bars are just as long as each other when \(p_t = 0.4\). That happens when \(-2 + 0.6\,(t - 1) = 0\), or \(t \approx 4.3\).

Each share we made up moves around its point by about \(\sqrt{p(1 - p) / 400}\),²² which is never more than 2.5 percent of the 400 kids.²³ That’s why the bars land so close to the points. Try changing the 0.6 in plogis(), and the week where the bars are just as long as each other moves earlier (larger values) or later (smaller values).²⁴

14.4 Grammar

CODE:

• Make the words around the graph²⁵ with labs()

• Start the graph with ggplot() and give it data

• Put week across the graph (x) and share up the side (y)²⁶

• Inside geom_bar()

  • join choice to fill so each drink gets its own color²⁷

  • use stat = "identity" and width = .5

• Add scale_y_continuous() to set the ends of the axis by hand²⁸ and show its numbers as a percent with scales::percent

labs_geom_bar_diverg <- labs(
  title = "Orbitz vs. Surge",
  caption = "Simulated data",
  subtitle = "Drink 400 kids bought each week in 1997",
  x = "Week",
  y = "Share of kids",
  fill = "Drink")
ggp2_bars_diverg <- ggplot(
  data = orbitz_diverg,
    aes(x = week, y = share)) +
  geom_bar(aes(fill = choice),
    stat = "identity", width = .5) +
  scale_y_continuous(limits = c(-1, 1),
    labels = scales::percent)

ggp2_bars_diverg +
  labs_geom_bar_diverg

GRAPH:

14.5 More info

To put the bars one above the other,²⁹ we put the column from the x axis on the y axis, and the other way around.

14.5.1 Vertically arranged bars

• Make the words around the graph with labs()

• Put share across the graph (x) and week up the side (y)

• Inside geom_bar()

  • join choice to fill so each drink gets its own color

  • use stat = "identity" and width = .5

• Add scale_x_continuous() to set the ends of the axis by hand and show its numbers as a percent with scales::percent

labs_geom_bar_diverg_vert <- labs(
  title = "Orbitz vs. Surge",
  caption = "Simulated data",
  subtitle = "Drink 400 kids bought each week in 1997",
  x = "Share of kids",
  y = "Week",
  fill = "Drink")
ggp2_bar_diverg_vert <- ggplot(
  data = orbitz_diverg,
      aes(x = share, y = week)) +
  geom_bar(
      aes(fill = choice),
        stat = "identity", width = .5) +
  scale_x_continuous(limits = c(-1, 1),
        labels = scales::percent)
ggp2_bar_diverg_vert +
  labs_geom_bar_diverg_vert

---

1. Two proportions.

2. Positive and negative values.

3. Standard or stacked bar graphs, where every bar starts at the baseline and extends in the same direction.

4. Diverging bar graphs display positive and negative quantities on both sides of a reference or baseline value (zero in this example).

5. Color, length, and position compare the quantities across the levels of a categorical variable (and within variable values).

6. The magenta (Orbitz) bars, which are negative.

7. The gold (Surge) bar vs. the magenta (Orbitz) bar.

8. Install and load the packages.

9. Colorful gel balls suspended in a clear, fruity drink.

10. Simulate.

11. A weekly lunchroom survey.

12. As the novelty of Orbitz wears off.

13. runif() draws a random number from a uniform distribution between 0 and 1.

14. The week’s probabilities.

15. Make the Orbitz share negative.

16. Setting the random seed.

17. The formula.

18. A stacked bar for each week, split three ways.

19. The expected shares we built into the simulation.

20. A multinomial distribution, which gives the counts in each of several categories when each of \(n\) independent draws falls in exactly one category.

21. The logistic function, which gives Surge’s share an S shaped climb.

22. The standard error of a proportion.

23. 2.5 percentage points.

24. The crossover point.

25. The labels (title, subtitle, caption, axis titles, and legend title).

26. Map week to x and share to y in aes().

27. Map choice to the fill aesthetic.

28. Manually set the axis limits and format the axis labels.

29. Vertically arranged bars.