The 30-Year Widening Wealth Gap

February 10, 2021

library(tidyverse)
library(readxl)
library(gganimate)
library(ggdark)

download.file("https://apps.urban.org/features/wealth-inequality-charts/data/WealthDistribution.xlsx", "WealthDistribution.xlsx")

wealth_dist <- read_xlsx("WealthDistribution.xlsx", range = "A2:M101") %>%
  rename(percentile = `...1`) %>%
  pivot_longer(`1963`:`2016`, names_to = "year", values_to = "wealth") %>%
  select(year, percentile, wealth) %>%
  mutate(year = as.integer(year)) %>%
  filter(year >= 1983) %>%
  arrange(desc(year), percentile)

p <- ggplot(wealth_dist, aes(percentile, wealth, fill = wealth)) +
  geom_col(color = "#6272a4", size = 0.2) +
  geom_hline(yintercept = 0, color = "#6272a4", size = 0.3) +
  transition_time(year) +
  scale_x_continuous(breaks = c(89.5, 98.5), labels = c("90%\n←", "1%\n→"), position = "top") +
  scale_y_continuous(breaks = c(0, 1000000, 10000000), labels = scales::dollar) +
  scale_fill_viridis_c(option = "plasma") +
  guides(color = FALSE, fill = FALSE) +
  labs(
    title = "The 30-Year Widening Wealth Gap",
    subtitle = "By 2016, a family in the top 1% is more than 10x wealthier than a family in the bottom 90%.",
    tags = "{floor(frame_time)}",
    caption = "Based on Urban Institute calculations in 2016 dollars from Survey of Consumer Finances 1983–2016\nRecreate this animation at nsgrantham.com/wealth-gap",
    x = NULL,
    y = NULL
  ) +
  dark_theme_minimal(base_family = "Inter-Light", base_size = 18) +
  theme(
    plot.title = element_text(family = "Inter-Medium", size = 28),
    plot.title.position = "plot",
    plot.subtitle = element_text(size = 13, margin = margin(0, 0, 1, 0, unit = "line")),
    plot.caption = element_text(size = 9, margin = margin(1, 0, 0, 0, unit = "line")),
    plot.caption.position = "plot",
    plot.tag = element_text(family = "RobotoMono-Medium", color = "#44475a", size = 100),
    plot.tag.position = c(0.6, 0.4),
    plot.background = element_rect(color = "#282a36", fill = "#282a36"),
    plot.margin = margin(1, 1, 1, 1, unit = "line"),
    panel.grid.major.x = element_line(color = "#44475a", size = 0.3),
    panel.grid.major.y = element_line(color = "#44475a", size = 0.3),
    panel.grid.minor.x = element_blank(),
    panel.grid.minor.y = element_blank(),
    axis.text.x = element_text(color = "#f8f8f2", size = 12),
    axis.text.y = element_text(color = "#f8f8f2", size = 12)
  )

animate(p, height = 6, width = 8, units = "in", res = 200, duration = 20, fps = 20, end_pause = 50, render = gifski_renderer("wealth-gap.gif"))

By 2016, a family in the top 1% is more than 10x wealthier than a family in the bottom 90%.


Thanks for reading — follow me on Twitter and subscribe to my newsletter. 🕺