adults-born-in-state-of-residence.R

library(tidycensus)
library(mapgl)
library(tidyverse)
library(sf)
library(tigris)
options(tigris_use_cache = TRUE)

adult_total_vars <- paste0("B06001_", sprintf("%03d", 4:12))
adult_born_vars <- paste0("B06001_", sprintf("%03d", 16:24))

state_birth <- get_acs(
  geography = "state",
  variables = c(adult_total_vars, adult_born_vars),
  survey = "acs1",
  year = 2024,
  geometry = TRUE,
  output = "wide"
) |>
  filter(GEOID != "72") |> # Puerto Rico not included in this stat
  mutate(
    adults = rowSums(across(all_of(paste0(adult_total_vars, "E")))),
    born = rowSums(across(all_of(paste0(adult_born_vars, "E")))),
    pct = 100 * born / adults,
    rank = min_rank(desc(pct)),
    bin = case_when(
      pct < 25 ~ "Under 25%",
      pct < 40 ~ "25% - 40%",
      pct < 55 ~ "40% - 55%",
      pct < 65 ~ "55% - 65%",
      .default = "Over 65%"
    ),
    pct_fmt = sprintf("%.1f%%", pct),
    rank_fmt = paste0("#", rank, " of ", n()),
    adults_fmt = scales::comma(adults)
  ) |>
  left_join(
    distinct(fips_codes, GEOID = state_code, abbr = state),
    by = "GEOID"
  ) |>
  mutate(label = paste0(abbr, "\n", pct_fmt)) |>
  select(
    GEOID,
    NAME,
    abbr,
    label,
    pct,
    pct_fmt,
    rank_fmt,
    adults_fmt,
    bin,
    geometry
  ) |>
  shift_geometry()

albers_center <- as.numeric(st_coordinates(st_centroid(st_union(state_birth))))

st_geometry(state_birth) <- st_set_crs(
  (st_geometry(state_birth) - albers_center) * 5e-6,
  4326
)

# national reference value for the legend title
us_birth <- get_acs(
  geography = "us",
  variables = c(adult_total_vars, adult_born_vars),
  survey = "acs1",
  year = 2024,
  output = "wide"
)
us_pct <- 100 *
  sum(us_birth[paste0(adult_born_vars, "E")]) /
  sum(us_birth[paste0(adult_total_vars, "E")])

bins <- c(
  "Over 65%",
  "55% - 65%",
  "40% - 55%",
  "25% - 40%",
  "Under 25%"
)
bin_colors <- c(
  "#a63d4f", # deep red
  "#d96b4f", # red-orange
  "#ec9f52", # orange
  "#f4c47c", # gold
  "#faeec4" # cream
)

birth_popup <- paste0(
  '<span style="font-weight:700;font-size:14px">{NAME}</span>',
  '<div style="height:1px;background:#edeff2;margin:8px -14px"></div>',
  '<div style="display:flex;justify-content:space-between;gap:18px">',
  '<span style="color:#6b7280">Born in state of residence</span>',
  '<span style="font-weight:600">{pct_fmt}</span>',
  "</div>",
  '<div style="display:flex;justify-content:space-between;gap:18px">',
  '<span style="color:#6b7280">Rank</span>',
  '<span style="font-weight:600">{rank_fmt}</span>',
  "</div>",
  '<div style="display:flex;justify-content:space-between;gap:18px">',
  '<span style="color:#6b7280">Adults (18+)</span>',
  '<span style="font-weight:600">{adults_fmt}</span>',
  "</div>"
)

maplibre(
  style = blank_style,
  bounds = state_birth
) |>
  add_fill_layer(
    id = "state-birth",
    source = state_birth,
    fill_color = match_expr(
      column = "bin",
      values = bins,
      stops = bin_colors,
      default = "#d9d9d9"
    ),
    fill_opacity = 0.85,
    fill_outline_color = "#ffffff",
    popup = birth_popup,
    popup_style = popup_style(
      background_color = "#ffffff",
      text_color = "#1f2937",
      border_radius = 10,
      padding = 14,
      font_family = "system-ui, -apple-system, 'Segoe UI', Roboto, sans-serif",
      font_size = 13,
      shadow = TRUE
    )
  ) |>
  add_symbol_layer(
    id = "state-birth-labels",
    source = st_centroid(state_birth, of_largest_polygon = TRUE),
    text_field = get_column("label"),
    text_size = 12,
    text_line_height = 1.1,
    text_allow_overlap = TRUE,
    text_color = match_expr(
      column = "bin",
      values = bins,
      stops = c("#ffffff", "#ffffff", "#402a12", "#402a12", "#402a12")
    ),
    text_halo_color = match_expr(
      column = "bin",
      values = bins,
      stops = c("#00000040", "#00000040", "#ffffff80", "#ffffff80", "#ffffff80")
    ),
    text_halo_width = 1
  ) |>
  add_categorical_legend(
    legend_title = paste0(
      "Adults living in the state<br>where they were born<br>",
      "2024 1-year ACS · US: ",
      sprintf("%.1f%%", us_pct)
    ),
    values = bins,
    colors = bin_colors,
    position = "bottom-left",
    style = legend_style(
      background_color = "white",
      background_opacity = 0.94,
      border_color = "#d1d5db",
      border_width = 1,
      shadow = TRUE
    )
  )