Making a waffle chart in R with the tidyverse to assess proposals for cutting the US budget (CC358)
Pat recreates a waffle chart using ggplot2 to recreate a plot showing one proposed approach to cut $1 trillion from the US budget. The plot was generated using functions from the tidyverse. To pull this off he uses the dplyr, ggplot2, showtext, and ggtext packages. The functions he uses from these packages include aes, arrange, bind_cols, bind_rows, ceiling, coord_cartesian, element_blank, element_text, element_textbox_simple, facet_wrap, factor, font_add_google, function, geom_point, geom_text, geom_tile, ggplot, ggsave, if, labeller, labs, library, map, margin, max, mutate, names, nest, paste0, pivot_longer, pull, round, scale_fill_manual, select, showtext_auto, showtext_opts, element_markdown, sum, theme, tibble, tribble, uncount, unit, unnest, and vars. The newsletter describing this visualization at a 30,000 ft view can be found here. You can find the original article here. The data he uses can be found here. If you have a figure that you would like to see me discuss in a future newsletter and episode of Code Club, email me at pat@riffomonas.org!
Code
library(tidyverse)
library(showtext)
library(ggtext)
font_add_google("Libre Franklin", "franklin")
showtext_opts(dpi = 300)
showtext_auto()
waffler <- function(d, n_rows = 7){
n_cols <- ceiling(sum(d$billions) / n_rows)
n_na <- n_cols * n_rows - sum(d$billions)
d <- uncount(d, billions) %>%
arrange(budget)
if(n_na != 0) {
d <- bind_rows(d, tibble(budget = rep(NA, n_na)))
}
bind_cols(d, expand_grid(col = 1:n_cols, row = 1:n_rows))
}
scale_factor <- 5 #$billions
nrows <- 5
budget <- tribble(
~category, ~billions, ~percent_cut, ~pretty,
"nondefense", 1031, 16, "**Nondefense discretionary funding**<br><span style='color:gray40;font-size:8pt;'>Federal programs, contracts, grants and employment</span>",
"defense", 866, 16, "**Defense**",
"medicaid", 831, 16, "**Medicaid, Obamacare, CHIP**<br><span style='color:gray40;font-size:8pt;'>CHIP is Children's Health Insurance Program</span>",
"other_benefits", 891, 16, "**Other benefits to individuals**<br><span style='color:gray40;font-size:8pt;'>Anti-poverty programs, farm aid, military retirement, other \"mandatory\" spending</span>",
"medicare", 1000, 16, "**Medicare**",
"social_security", 1664, 16, "**Social Security**"
) %>%
mutate(bill_cut = billions * percent_cut / 100,
bill_remain = billions - bill_cut,
category = factor(category, levels = category))
data <- budget %>%
select(category, cut = bill_cut, remain = bill_remain) %>%
pivot_longer(-category, values_to = "billions", names_to = "budget") %>%
mutate(billions = round(billions / scale_factor, digits = 0),
budget = factor(budget, levels = c("remain", "cut"))) %>%
nest(data = -category) %>%
mutate(waffle = map(data, waffler, n_row = nrows)) %>%
select(category, waffle) %>%
unnest(waffle)
pretty_labels <- pull(budget, pretty)
names(pretty_labels) <- pull(budget, category)
pretty_cut <- budget %>%
mutate(y = nrows,
x = ceiling(max(billions) / scale_factor / nrows),
label = paste0(percent_cut, "% cut")) %>%
select(category, x, y, label)
data %>%
ggplot(aes(x = col, y = row, fill = budget)) +
geom_tile(color = "white", linewidth = 0.3, show.legend = FALSE) +
geom_point(data = tibble(category = factor("social_security"),
col = 1, row = -2,
budget = "remain"),
shape = "square", color = "#9E9E9E", size = 2,
show.legend = FALSE) +
geom_text(data = tibble(category = factor("social_security"),
col = 2, row = -2,
budget = "remain"),
label = "Each box represents $5 billion in projected fiscal year 2026 spending. Defense and nondefense\ndiscretionary amounts represent budget authority.",
color = "#9E9E9E", family = "franklin", size = 8, size.unit = "pt",
hjust = 0, vjust = 0.8, lineheight = 1, show.legend = FALSE) +
geom_text(data = pretty_cut,
aes(x = x, y = y, label = label),
hjust = 0.95, vjust = -0.8,
family = "franklin", fontface = "bold",
size = 10, size.unit = "pt", color = "#FC1F76",
inherit.aes = FALSE) +
facet_wrap(vars(category), ncol = 1,
labeller = labeller(category = pretty_labels)) +
labs(
title = "How to reach $1 trillion <span style='color:#FC1F76;'>if Social Security and Medicare are added as equal cuts:</span>",
caption = "Source: Analysis of Congressional Budget Office data by Richard Kogan, Center on Budget and Policy Priorities • Note: Interest payments on the federal debt are not shown. • The New York Times"
) +
scale_fill_manual(
breaks = c("remain", "cut"),
values = c("#9E9E9E", "#FFADC9"), na.value = "#FFFFFF"
) +
coord_cartesian(expand = FALSE, clip = "off") +
theme(
text = element_text(family = "franklin"),
panel.grid = element_blank(),
panel.background = element_blank(),
axis.title = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
plot.title = element_textbox_simple(face = "bold", size = 14,
margin = margin(b = 10)),
plot.caption = element_textbox_simple(color = "gray40", size = 8.5,
lineheight = 1.3,
margin = margin(t = 20, b = 5)),
strip.text = element_markdown(hjust = 0, size = 10, lineheight = 1,
margin = margin(0, 0, 2, 0)),
strip.background = element_blank(),
panel.spacing.y = unit(-10, "pt")
)
ggsave("budget_waffle.png", width = 6, height = 6.4)