birth-state-puma-us-only.R

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

# Universe: adults (18+) born in the 50 states or DC. Excludes the
# foreign-born as well as natives born in Puerto Rico, the U.S. Island
# Areas, or abroad to U.S.-citizen parents, none of whom have a state
# of birth.
adult_born_vars <- paste0("B06001_", sprintf("%03d", 16:24)) # born in state of residence, 18+
adult_other_state_vars <- paste0("B06001_", sprintf("%03d", 28:36)) # born in another state, 18+

puma_birth <- get_acs(
  geography = "public use microdata area",
  variables = c(adult_born_vars, adult_other_state_vars),
  survey = "acs1",
  year = 2024,
  geometry = TRUE,
  output = "wide"
) |>
  filter(!str_starts(GEOID, "72")) |>
  mutate(
    born = rowSums(across(all_of(paste0(adult_born_vars, "E")))),
    other_state = rowSums(across(all_of(paste0(adult_other_state_vars, "E")))),
    adults = born + other_state,
    # round before binning so the bin always agrees with the displayed value
    pct = round(100 * born / adults, 1),
    bin = case_when(
      is.na(pct) ~ "No data",
      pct < 45 ~ "Under 45%",
      pct < 55 ~ "45% - 55%",
      pct < 65 ~ "55% - 65%",
      pct < 75 ~ "65% - 75%",
      pct < 85 ~ "75% - 85%",
      .default = "Over 85%"
    ),
    pct_fmt = if_else(is.na(pct), "No data", sprintf("%.1f%%", pct)),
    adults_fmt = if_else(is.na(pct), "No data", scales::comma(adults)),
    state_label = str_extract(NAME, "(?<=; ).+$"),
    puma_label = NAME |>
      str_remove("; .+$") |>
      str_remove(" PUMA$") |>
      str_replace_all("--", " — ")
  ) |>
  select(
    GEOID,
    puma_label,
    state_label,
    pct,
    pct_fmt,
    adults_fmt,
    bin,
    geometry
  )

bins <- c(
  "Over 85%",
  "75% - 85%",
  "65% - 75%",
  "55% - 65%",
  "45% - 55%",
  "Under 45%",
  "No data"
)
bin_colors <- c(
  "#7f1d3a", # dark red
  "#a63d4f", # deep red
  "#d96b4f", # red-orange
  "#ec9f52", # orange
  "#f4c47c", # gold
  "#faeec4", # cream
  "#d9d9d9" # no data
)

birth_popup <- paste0(
  '<span style="font-weight:700;font-size:14px">{puma_label}</span><br>',
  '<span style="color:#6b7280;font-size:12px">{state_label}</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">U.S.-born adults (18+)</span>',
  '<span style="font-weight:600">{adults_fmt}</span>',
  "</div>"
)

m1 <- maplibre(
  style = openfreemap_style("positron"),
  center = c(-98.58, 39.83),
  zoom = 3.6
) |>
  add_fill_layer(
    id = "puma-birth",
    source = puma_birth,
    fill_color = match_expr(
      column = "bin",
      values = bins,
      stops = bin_colors,
      default = "#d9d9d9"
    ),
    fill_opacity = 0.85,
    fill_outline_color = "#ffffff40",
    before_id = "waterway_line_label",
    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
    ),
    hover_options = list(
      fill_color = "cyan"
    )
  ) |>
  add_categorical_legend(
    legend_title = "U.S.-born adults living in<br>their state of birth<br><hr>2024 1-year ACS by PUMA",
    values = bins,
    colors = bin_colors,
    position = "bottom-left",
    layer_id = "puma-birth",
    interactive = TRUE,
    filter_column = "bin",
    style = legend_style(
      background_color = "white",
      background_opacity = 0.94,
      border_color = "#d1d5db",
      border_width = 1,
      shadow = TRUE
    )
  )

m1