PUMS Housing Affordability Analysis

TidyCensus reference:

https://walker-data.com/census-r/index.html

See, particularly, chapters 9 and 10.

Script:

# =========================================================
# 1. Load required libraries
# =========================================================

if (!require("tidycensus")) install.packages("tidycensus")
if (!require("tidyverse")) install.packages("tidyverse")
if (!require("tigris")) install.packages("tigris")
if (!require("sf")) install.packages("sf")
if (!require("leaflet")) install.packages("leaflet")

library(tidycensus)
library(tidyverse)
library(tigris)
library(sf)
library(leaflet)


# =========================================================
# 2. (Optional) Set Census API key
# =========================================================

# NOTE:
# If you do not already have a Census API key installed,
# uncomment the lines below and replace with your key.
#
# Get a key here:
# https://api.census.gov/data/key_signup.html

# census_api_key("YOUR_API_KEY_HERE", install = TRUE)
# readRenviron("~/.Renviron")

# Restart R after running once to activate the key


# =========================================================
# 3. Load Tennessee PUMAs (2020)
# =========================================================

options(tigris_use_cache = TRUE)

TN_PUMAs <- pumas(
  state = "TN",
  cb = TRUE,
  year = 2020
)


# =========================================================
# 4. Define Nashville PUMAs
# =========================================================

PUMA_list <- c(
  "02401",
  "02402",
  "02403",
  "02404",
  "02405",
  "02406"
)

NASH_PUMAs <- TN_PUMAs %>%
  filter(PUMACE20 %in% PUMA_list)


# =========================================================
# 5. Prepare geometry for Leaflet
# =========================================================

NASH_PUMAs <- st_transform(NASH_PUMAs, 4326)


# =========================================================
# 6. Create Leaflet map of Nashville PUMAs
# =========================================================

leaflet(data = NASH_PUMAs) %>%
  addProviderTiles(providers$CartoDB.Positron) %>%
  setView(lng = -86.78, lat = 36.17, zoom = 10) %>%
  addPolygons(
    fillColor = "steelblue",
    fillOpacity = 0.5,
    color = "black",
    weight = 1,
    highlightOptions = highlightOptions(
      weight = 2,
      color = "white",
      bringToFront = TRUE
    ),
    popup = ~paste0(
      "<strong>PUMA GEOID:</strong> ", GEOID20, "<br>",
      "<strong>PUMA code:</strong> ", PUMACE20, "<br>",
      "<strong>Name:</strong> ", NAMELSAD20
    )
  )


# =========================================================
# 7. Define housing affordability variables
# =========================================================

vars <- c(
  "TEN", "GRNTP", "RNTP", "GRPIP",
  "HINCP",
  "NP", "NOC",
  "AGEP", "RAC1P", "HISP",
  "SCHL", "ESR",
  "ELEP", "GASP", "WATP", "FULP",
  "RMSP", "BDSP",
  "PUMA", "WGTP"
)


# =========================================================
# 8. View codebooks (full + analysis variables)
# =========================================================

data(pums_variables)
data <- pums_variables

# ---- Full codebook ----

pums_codebook_full <- pums_variables %>%
  filter(
    survey == "acs5",
    year == 2023)

# ---- Analysis codebook (variables used in analysis) ----

pums_codebook_analysis <- pums_codebook_full %>%
  filter(
    var_code %in% vars
  ) %>%
  select(var_code,
         var_label,
         level,
         val_min,
         val_max,
         val_label,
         recode) %>%
  arrange(var_code)


# =========================================================
# 9. Pull Tennessee renter microdata (ACS 1-year, 2024)
# =========================================================

TN_Renters <- get_pums(
  variables = vars,
  state = "TN",
  survey = "acs1",
  variables_filter = list(TEN = 3),
  year = 2024
)


# =========================================================
# 10. Filter to Nashville PUMAs
# =========================================================

NASH_Renters <- TN_Renters %>%
  filter(PUMA %in% PUMA_list)


# =========================================================
# 11. Convert key variables to numeric
# =========================================================

NASH_Renters <- NASH_Renters %>%
  mutate(across(
    c(GRNTP, RNTP, GRPIP, HINCP,
      NP, NOC, AGEP, SCHL,
      ELEP, GASP, WATP, FULP,
      RMSP, BDSP, WGTP),
    as.numeric
  ))


# =========================================================
# 12. Create affordability measures
# =========================================================

NASH_Renters <- NASH_Renters %>%
  mutate(
    annual_rent = GRNTP * 12,
    residual_income = HINCP - annual_rent,
    cost_burdened = GRPIP >= 30,
    severe_burden = GRPIP >= 50,
    college = SCHL >= 21
  )


# =========================================================
# 13. Basic weighted summary statistics
# =========================================================

summary_stats <- NASH_Renters %>%
  summarize(
    pct_cost_burdened =
      weighted.mean(cost_burdened, WGTP, na.rm = TRUE),
    
    pct_severe_burden =
      weighted.mean(severe_burden, WGTP, na.rm = TRUE),
    
    avg_rent =
      weighted.mean(GRNTP, WGTP, na.rm = TRUE),
    
    avg_income =
      weighted.mean(HINCP, WGTP, na.rm = TRUE)
  )

print(summary_stats)


# =========================================================
# 14. Save dataset for reuse
# =========================================================

saveRDS(NASH_Renters, "nashville_renters_acs1_2024.rds")