#Data 608 Story 6
library(tidyverse)
library(janitor)
library(scales)
library(ggplot2)
library(ggtext)
library(ggrepel)
library(patchwork)
library(ggtext)
library(maps)
library(mapproj)
dir.create("plots", showWarnings = FALSE)
# Theme --------------------------------------------------------------------
bg <- "#0f1923"
bg_panel <- "#131f2b"
clr_spine <- "#1e2d3d"
clr_g_bright <- "#2ecc71"
clr_g_fill <- "#1a4a2e"
clr_g_bar_fill <- "#0d3320"
clr_r_bright <- "#e74c3c"
clr_r_fill <- "#4a1a1a"
clr_r_bar_fill <- "#3d0d0d"
clr_text <- "#dce6f0"
clr_text2 <- "#7f99b2"
clr_gold <- "#f1c40f"
clr_gold_bg <- "#1a1200"
theme_hunger_dark <- function(base_size = 13) {
theme_minimal(base_size = base_size) %+replace%
theme(
plot.background = element_rect(fill = bg, color = NA),
panel.background = element_rect(fill = bg_panel, color = NA),
panel.grid.major = element_line(color = clr_spine, linewidth = 0.35),
panel.grid.minor = element_blank(),
plot.title = element_text(face = "bold", size = base_size * 1.45,
color = clr_text, margin = margin(b = 6)),
plot.subtitle = element_text(size = base_size * 0.95, color = clr_text2,
margin = margin(b = 12), lineheight = 1.35),
plot.caption = element_text(size = base_size * 0.72, color = clr_text2,
hjust = 0, margin = margin(t = 10)),
axis.title = element_text(size = base_size * 0.9, color = clr_text2,
face = "bold"),
axis.text = element_text(size = base_size * 0.82, color = clr_text2),
legend.background = element_rect(fill = bg, color = NA),
legend.position = "bottom",
legend.title = element_text(face = "bold", color = clr_text),
legend.text = element_text(color = clr_text2),
strip.background = element_rect(fill = clr_spine, color = NA),
strip.text = element_text(face = "bold", color = clr_text,
size = base_size * 0.9),
plot.margin = margin(16, 20, 12, 16)
)
}
theme_set(theme_hunger_dark())
# Data loading --------------------------------------------------------------------
food_insecurity_state <- read_csv("data/food_insecurity_state.csv") |>
clean_names() |>
mutate(fi_rate_pct = fi_rate / 100, vlfs_rate_pct = vlfs_rate / 100)
poverty_state <- read_csv("data/poverty_state.csv") |> clean_names()
demographics <- read_csv("data/demographics.csv") |> clean_names()
pipeline <- read_csv("data/pipeline.csv") |> clean_names() |>
mutate(stage_label = factor(stage_label, levels = stage_label))
cost_data <- read_csv("data/cost_data.csv") |> clean_names()
trend_data <- read_csv("data/trend_data.csv") |> clean_names()
combined <- food_insecurity_state |>
left_join(poverty_state |> select(state_abbr, poverty_rate), by = "state_abbr")
cor_val <- cor(combined$poverty_rate, combined$fi_rate, use = "complete.obs")
cat(sprintf("Pearson r: %.3f\n", cor_val))
## Pearson r: 0.968
# Slide 1 : Map --------------------------------------------------------------------
us_map <- map_data("state") |> mutate(state = str_to_title(region))
map_data_full <- us_map |>
left_join(
food_insecurity_state |>
mutate(state = str_to_title(state)) |>
select(state, fi_rate, vlfs_rate, region),
by = "state"
)
state_labels <- food_insecurity_state |>
mutate(state_lower = str_to_lower(state)) |>
left_join(
map_data("state") |>
group_by(region) |>
summarise(long = mean(long), lat = mean(lat), .groups = "drop"),
by = c("state_lower" = "region")
)
p_slide1 <- ggplot(map_data_full, aes(x = long, y = lat, group = group)) +
geom_polygon(aes(fill = fi_rate), color = bg, linewidth = 0.35) +
geom_text(
data = state_labels |> filter(fi_rate >= 16),
aes(x = long, y = lat,
label = paste0(state_abbr, "\n", fi_rate, "%"), group = NULL),
size = 2.8, fontface = "bold", color = "white"
) +
coord_map("albers", lat0 = 39, lat1 = 45) +
scale_fill_gradient(
low = "#f5e6e6", # near-white with a warm tint
high = "#c0392b", # deep red for highest severity
name = "Food Insecurity Rate (%)", labels = label_number(suffix = "%")
) +
labs(
title = "Hunger Is Here",
subtitle = paste0(
"47 million Americans struggle to put food on the table : right here, right now.\n",
"Darkest states exceed 19% food insecurity. National average: 13.5%."
),
caption = ""
) +
theme_void(base_size = 13) +
theme(
plot.background = element_rect(fill = bg, color = NA),
panel.background = element_rect(fill = bg, color = NA),
plot.title = element_text(face = "bold", size = 18, color = clr_text,
margin = margin(l = 10, t = 10, b = 4)),
plot.subtitle = element_text(size = 12, color = clr_text2,
margin = margin(l = 10, b = 10), lineheight = 1.35),
plot.caption = element_text(size = 9, color = clr_text2,
margin = margin(b = 8, l = 10)),
legend.background = element_rect(fill = bg, color = NA),
legend.position = "bottom",
legend.title = element_text(face = "bold", color = clr_text),
legend.text = element_text(color = clr_text2),
legend.key.width = unit(2.5, "cm"),
plot.margin = margin(10, 10, 10, 10)
)
p_slide1
ggsave("plots/slide1_map.png", p_slide1, width = 12, height = 7, dpi = 150, bg = bg)
# Slikde 2 : Scatterplot --------------------------------------------------------------------
p_slide2 <- ggplot(combined, aes(x = poverty_rate, y = fi_rate)) +
# Crisis zone
annotate("rect", xmin = 14, xmax = Inf, ymin = 15, ymax = Inf,
fill = clr_r_bright, alpha = 0.07) +
# Crisis zone label
annotate("text", x = 19.5, y = 16.0, label = "CRISIS\nZONE",
size = 3.5, color = clr_r_bright, fontface = "bold",
alpha = 0.7, hjust = 1, vjust = 0) +
geom_smooth(method = "lm", se = TRUE, color = clr_text2,
fill = clr_spine, alpha = 0.35, linewidth = 1.2) +
geom_point(aes(fill = fi_rate), shape = 21, size = 4.5,
color = "#00000040", stroke = 0.3, alpha = 0.95) +
geom_text_repel(
data = combined |> filter(fi_rate > 15.5 | fi_rate < 9.3),
aes(label = state_abbr), size = 3.3, fontface = "bold", color = clr_text,
box.padding = 0.45, max.overlaps = 25,
segment.color = clr_text2, segment.size = 0.35
) +
scale_fill_gradient(
low = "#f5deb3", # wheat / near-white warm
high = "#c0392b", # deep red matching map
name = "Food Insecurity\nRate (%)",
guide = guide_colorbar(title.position = "top", barwidth = 8, barheight = 0.5)
) +
scale_x_continuous(labels = label_percent(scale = 1), breaks = seq(6, 20, 2)) +
scale_y_continuous(labels = label_percent(scale = 1), breaks = seq(8, 20, 2)) +
annotate("label", x = 7.5, y = 17.3,
label = sprintf("Pearson r = %.2f\nStrong positive\ncorrelation", cor_val),
hjust = 0, size = 3.8, color = clr_text, fontface = "bold",
fill = clr_spine, label.color = clr_text2,
label.size = 0.4, label.padding = unit(0.4, "lines")) +
labs(
title = "And Its Structural",
subtitle = "State poverty rates and food insecurity move hand in hand across all U.S. regions",
x = "Poverty Rate : Census ACS 2023 (%)",
y = "Food Insecurity Rate : USDA ERS 2022–24 (%)",
caption = "Sources: U.S. Census Bureau ACS 2023; USDA Economic Research Service 2022-2024"
)
print(p_slide2)
ggsave("plots/slide2_scatter.png", p_slide2, width = 11, height = 7, dpi = 150, bg = bg)
# Slide 3 : Vulnerable demographics --------------------------------------------------------------------
p_slide3 <- demographics |>
filter(category == "Household Type") |>
mutate(
group = fct_reorder(group, fi_rate),
# flag the children-present households for extra emphasis
has_child = str_detect(group, "children")
) |>
ggplot(aes(x = fi_rate, y = group, fill = fi_rate)) +
geom_col(width = 0.62, show.legend = FALSE) +
# National average reference line
geom_vline(xintercept = 13.5, linetype = "dashed",
color = clr_text2, linewidth = 0.7, alpha = 0.8) +
# Dollar labels just beyond bar tip
geom_text(aes(x = fi_rate + 0.6, label = paste0(fi_rate, "%")),
hjust = 0, fontface = "bold", size = 5.0, color = clr_text) +
# National avg annotation
annotate("text",
x = 14.0, y = 1.45,
label = "National avg\n13.5%",
color = clr_text2, fontface = "italic",
size = 3.2, hjust = 0, lineheight = 0.9) +
scale_fill_gradient(low = "#b7950b", high = clr_r_bright) +
scale_x_continuous(
limits = c(0, 46),
labels = label_percent(scale = 1),
expand = c(0, 0)
) +
labs(
title = "It Falls On Our Most Vulnerable",
subtitle = paste0(
"Households with children, especially single-mother homes \n",
" face rates more than double the national average."
),
x = "Food Insecurity Rate (%)",
y = NULL,
caption = "Source: USDA ERS Household Food Security in the United States, 2023"
) +
theme_hunger_dark(base_size = 14) +
theme(
panel.background = element_rect(fill = bg, color = NA),
panel.grid.major.y = element_blank(),
panel.grid.major.x = element_line(color = clr_spine, linewidth = 0.3),
axis.text.y = element_text(size = 12.5, color = clr_text,
face = "bold"),
axis.text.x = element_text(size = 11, color = clr_text2),
plot.margin = margin(16, 40, 12, 16)
)
print(p_slide3)
ggsave("plots/slide3_demographics.png", p_slide3,
width = 12, height = 6, dpi = 150, bg = bg)
# Slide 4 : Dependancy pipeline --------------------------------------------------------------------
n_stages <- nrow(pipeline)
ribbon_df <- map_dfr(seq_len(n_stages - 1), function(i) {
tibble(x = c(i, i, i+1, i+1),
y = c(0, pipeline$value[i], pipeline$value[i+1], 0),
grp = as.character(i))
})
p_slide4 <- ggplot() +
geom_polygon(data = ribbon_df, aes(x = x, y = y, group = grp),
fill = clr_r_bright, alpha = 0.15) +
geom_col(data = pipeline |> mutate(x = as.integer(stage_label)),
aes(x = x, y = value, fill = value),
width = 0.55, show.legend = FALSE) +
geom_text(data = pipeline |> mutate(x = as.integer(stage_label)),
aes(x = x, y = value / 2, label = paste0(value, "%")),
color = "white", fontface = "bold", size = 4.5) +
geom_text(data = pipeline |> mutate(x = as.integer(stage_label)),
aes(x = x, y = value + 5, label = annotation),
color = clr_text2, size = 3.0, lineheight = 0.9, fontface = "italic") +
scale_x_continuous(breaks = seq_len(n_stages), labels = levels(pipeline$stage_label)) +
scale_fill_gradient(low = "#e67e22", high = clr_r_bright) +
scale_y_continuous(limits = c(0, 130), labels = NULL) +
annotate("segment", x = 1.05, xend = 5.95, y = 112, yend = 112,
arrow = arrow(ends = "last", length = unit(0.25, "cm"), type = "closed"),
color = clr_text2, linewidth = 0.9) +
annotate("text", x = 3.5, y = 121,
label = "The hunger-to-dependency pipeline",
color = clr_text, fontface = "bold", size = 4.2) +
labs(
title = "And Traps Our Children",
subtitle = paste0(
"A Hungry Child Becomes a Dependent Adult\n",
"Food insecurity in childhood triggers a cascade of disadvantages."
),
x = NULL, y = NULL,
caption = "Sources: Health Affairs (2015); Children's Health Watch; CBPP (2024); USDA ERS"
) +
theme(axis.text.x = element_text(size = 10, color = clr_text,
face = "bold", lineheight = 0.9),
panel.grid.major.x = element_blank())
print(p_slide4)
ggsave("plots/slide4_pipeline.png", p_slide4, width = 13, height = 7, dpi = 150, bg = bg)
# Slide 5 : Program by program --------------------------------------------------------------------
invest_bars <- cost_data |>
filter(type == "Investment") |>
arrange(amount_billions) |> # smallest at top
mutate(category = fct_inorder(category))
conseq_bars <- cost_data |>
filter(type == "Consequence") |>
arrange(amount_billions) |> # smallest at top
mutate(category = fct_inorder(category))
invest_total <- cost_data |> filter(type == "Investment") |> pull(amount_billions) |> sum()
conseq_total <- cost_data |> filter(type == "Consequence") |> pull(amount_billions) |> sum()
# Shared x limit — a little beyond the largest single bar
x_max_shared <- max(cost_data$amount_billions) * 1.18
# Investment -------------------
p_invest <- ggplot(invest_bars,
aes(x = amount_billions, y = category)) +
geom_col(fill = clr_g_fill, color = clr_g_bright,
linewidth = 0.7, width = 0.62) +
geom_text(aes(x = amount_billions / 2,
label = paste0("$", amount_billions, "B")),
color = clr_g_bright, fontface = "bold",
size = 4.2, hjust = 0.5) +
scale_x_continuous(
limits = c(0, x_max_shared),
expand = c(0, 0),
labels = label_dollar(suffix = "B", prefix = "$")
) +
scale_y_discrete(expand = expansion(add = c(0.8, 0.5))) +
labs(
title = "What We Could Invest In",
subtitle = "Annual federal nutrition program budgets",
x = NULL, y = NULL
) +
theme_hunger_dark(base_size = 13) +
theme(
panel.background = element_rect(fill = bg, color = NA),
panel.grid.major.y = element_blank(),
panel.grid.major.x = element_line(color = clr_spine, linewidth = 0.3),
axis.text.y = element_text(size = 11, color = clr_text,
face = "bold", hjust = 1),
axis.text.x = element_blank(),
plot.title = element_text(color = clr_g_bright, face = "bold",
size = 15, margin = margin(b = 4)),
plot.subtitle = element_text(color = clr_text2, size = 10,
margin = margin(b = 10)),
plot.margin = margin(12, 16, 24, 16)
)
# Consequences ------------------------------------
p_conseq <- ggplot(conseq_bars,
aes(x = amount_billions, y = category)) +
geom_col(fill = clr_r_fill, color = clr_r_bright,
linewidth = 0.7, width = 0.62) +
geom_text(aes(x = amount_billions / 2,
label = paste0("$", amount_billions, "B")),
color = clr_r_bright, fontface = "bold",
size = 4.2, hjust = 0.5) +
scale_x_continuous(
limits = c(0, x_max_shared),
expand = c(0, 0),
labels = label_dollar(suffix = "B", prefix = "$")
) +
scale_y_discrete(expand = expansion(add = c(0.8, 0.5))) +
labs(
title = "What We Lose",
subtitle = "Annual downstream costs of child food insecurity",
x = NULL, y = NULL
) +
theme_hunger_dark(base_size = 13) +
theme(
panel.background = element_rect(fill = bg, color = NA),
panel.grid.major.y = element_blank(),
panel.grid.major.x = element_line(color = clr_spine, linewidth = 0.3),
axis.text.y = element_text(size = 11, color = clr_text,
face = "bold", hjust = 1),
axis.text.x = element_blank(),
plot.title = element_text(color = clr_r_bright, face = "bold",
size = 15, margin = margin(b = 4)),
plot.subtitle = element_text(color = clr_text2, size = 10,
margin = margin(b = 10)),
plot.margin = margin(12, 16, 24, 16)
)
# Both together
p_slide5_bars <- (p_conseq | p_invest) +
plot_annotation(
title = paste0(
"The Consequences of <span style='color:", clr_r_bright, ";'>Inaction</span>",
" : Generational<br>",
"The Cost of <span style='color:", clr_g_bright, ";'>Action</span>",
" : A Modest Budget Line"
),
subtitle = "",
caption = "Sources: USDA FNS FY2024; CBPP 2024; Children's Health Watch; Health Affairs (2015)",
theme = theme(
plot.background = element_rect(fill = bg, color = NA),
plot.title = element_markdown(face = "bold", size = 18,
color = clr_text, hjust = 0.5,
margin = margin(b = 6),
lineheight = 1.4),
plot.subtitle = element_text(size = 11, color = clr_text2,
hjust = 0.5, margin = margin(b = 12)),
plot.caption = element_text(size = 9, color = clr_text2, hjust = 0)
)
)
print(p_slide5_bars)
ggsave("plots/slide5_breakdown.png", p_slide5_bars,
width = 13, height = 7, dpi = 150, bg = bg)
# Slide 6 --------------------------------------------------------------------
invest_total <- cost_data |> filter(type == "Investment") |> pull(amount_billions) |> sum()
consequence_total <- cost_data |> filter(type == "Consequence") |> pull(amount_billions) |> sum()
roi_ratio <- round(consequence_total / invest_total, 1)
gap_b <- 18 # visible gap = 18B equivalent height — big enough to see clearly
# Investment bar positions
invest_programs <- cost_data |>
filter(type == "Investment") |>
arrange(desc(amount_billions)) |>
mutate(
xc = c(3, 1.5, 4.5),
bar_w = 0.70,
ymin = gap_b,
ymax = gap_b + amount_billions,
dollar_y = gap_b + amount_billions / 2, # center of bar
name_y = gap_b + amount_billions + 6 # just above bar tip
)
# Consequence bar positions
conseq_programs <- cost_data |>
filter(type == "Consequence") |>
arrange(desc(amount_billions)) |>
mutate(
# 4 bars spread across x = 1 to 5
xc = c(3, 1.8, 4.2, 0.6),
bar_w = 0.70,
ymin = -(gap_b + amount_billions),
ymax = -gap_b,
dollar_y = -(gap_b + amount_billions / 2), # center of bar
name_y = -(gap_b + amount_billions + 6) # just below bar tip
)
y_top <- gap_b + max(invest_programs$amount_billions) + 28
y_bot <- -(gap_b + max(conseq_programs$amount_billions) + 28)
x_left <- -0.3
x_right <- 6.0
p_slide5_bars <- ggplot() +
# Middle gap
annotate("rect",
xmin = x_left, xmax = 5.5,
ymin = -gap_b, ymax = gap_b,
fill = bg, color = NA) +
# Gap label
annotate("text",
x = 2.5, y = 0,
label = "— this is the gap of inaction —",
color = clr_text2, fontface = "italic",
size = 4.5, hjust = 0.5, vjust = 0.5) +
# Upper gap line
annotate("segment",
x = x_left, xend = 5.5,
y = gap_b, yend = gap_b,
color = clr_g_bright, linewidth = 0.7, linetype = "solid") +
# Lower gap line
annotate("segment",
x = x_left, xend = 5.5,
y = -gap_b, yend = -gap_b,
color = clr_r_bright, linewidth = 0.7, linetype = "solid") +
# Investent bars
geom_rect(data = invest_programs,
aes(xmin = xc - bar_w / 2, xmax = xc + bar_w / 2,
ymin = ymin, ymax = ymax),
fill = clr_g_fill, color = clr_g_bright, linewidth = 0.8) +
geom_text(data = invest_programs,
aes(x = xc, y = dollar_y,
label = paste0("$", amount_billions, "B")),
color = clr_g_bright, fontface = "bold",
size = 5.0, hjust = 0.5) +
geom_text(data = invest_programs,
aes(x = xc, y = name_y, label = category),
color = clr_text, fontface = "bold",
size = 3.4, hjust = 0.5, vjust = 0, lineheight = 0.92) +
# Consequence bars
geom_rect(data = conseq_programs,
aes(xmin = xc - bar_w / 2, xmax = xc + bar_w / 2,
ymin = ymin, ymax = ymax),
fill = clr_r_fill, color = clr_r_bright, linewidth = 0.8) +
geom_text(data = conseq_programs,
aes(x = xc, y = dollar_y,
label = paste0("$", amount_billions, "B")),
color = clr_r_bright, fontface = "bold",
size = 5.0, hjust = 0.5) +
geom_text(data = conseq_programs,
aes(x = xc, y = name_y, label = category),
color = clr_text, fontface = "bold",
size = 3.4, hjust = 0.5, vjust = 1, lineheight = 0.92) +
# Scales
scale_x_continuous(limits = c(x_left, 7.4), expand = c(0, 0)) +
scale_y_continuous(limits = c(y_bot, y_top), expand = c(0, 0)) +
labs(x = NULL, y = NULL) +
theme_void() +
theme(
plot.background = element_rect(fill = bg, color = NA),
plot.margin = margin(4, 8, 4, 8)
)
# Header
p_s5_header <- ggplot() +
theme_void() +
theme(plot.background = element_rect(fill = bg, color = NA)) +
annotate("text",
x = 0.5, y = 0.80,
label = "The Choice Is Clear",
color = clr_text, fontface = "bold", size = 6.5, hjust = 0.5) +
annotate("segment",
x = 0.05, xend = 0.95, y = 0.44, yend = 0.44,
color = clr_spine, linewidth = 0.6) +
annotate("richtext",
x = 0.5, y = 0.18,
label = paste0(
"<span style='color:", clr_g_bright, ";'>$", invest_total,
"B invested in nutrition programs</span>",
" OR ",
"<span style='color:", clr_r_bright, ";'>$", consequence_total,
"B lost in downstream consequences</span>",
" : every year."
),
color = clr_text, size = 4.1,
hjust = 0.5, fill = NA, label.color = NA) +
scale_x_continuous(limits = c(0, 1), expand = c(0, 0)) +
scale_y_continuous(limits = c(0, 1), expand = c(0, 0))
# Caption
p_s5_caption <- ggplot() +
theme_void() +
theme(plot.background = element_rect(fill = bg, color = NA)) +
annotate("text",
x = 0.03, y = 0.5,
label = paste0(
"Sources: USDA FNS FY2024; CBPP 2024; Children's Health Watch; ",
"Robert Wood Johnson Foundation; Health Affairs (2015)"
),
color = clr_text2, size = 3.0, hjust = 0) +
scale_x_continuous(limits = c(0, 1), expand = c(0, 0)) +
scale_y_continuous(limits = c(0, 1), expand = c(0, 0))
# Together
p_slide5 <- p_s5_header / p_slide5_bars / p_s5_caption +
plot_layout(heights = c(0.9, 8.5, 0.3))
print(p_slide5)
ggsave("plots/slide5_dome.png", p_slide5,
width = 13, height = 11, dpi = 150, bg = bg)