R/census_helpers.R

In CT-Data-Haven/cwi: Prep for DataHaven's Community Wellbeing Index

## UTILS ----
wrap_census <- function(src, geography, table, year, state, dataset, key, ...) {
  if (src == "acs") {
    suppressMessages(
      httr::with_config(
        httr::user_agent("cwi"),
        tidycensus::get_acs(geography = geography, table = table, year = year, state = state, survey = dataset, key = key, cache_table = TRUE, ...)
        )
      )
  } else if (src == "decennial") {
    suppressMessages(
      httr::with_config(
        httr::user_agent("cwi"),
        tidycensus::get_decennial(geography = geography, table = table, year = year, state = state, sumfile = dataset, key = key, cache_table = TRUE, ...)
        )
      )
  } else {
    return(NULL)
  }
}



## TOWNS ----
# fetch all in the state, then filter by county or arg
census_towns <- function(src, table, year, towns, counties, state, dataset, key, sleep, ...) {
  # tidycensus now handles skipped levels in hierarchy i.e. can get towns w/o specifying counties
  Sys.sleep(sleep)

  xw <- county_x_state(state, counties)
  fetch <- wrap_census(src, geography = "county subdivision", table = table, year = year, state = state, dataset = dataset, key = key, ...)
  fetch <- town_names(fetch, NAME)
  fetch$county_geoid <- substr(fetch$GEOID, 1, 5)
  fetch <- dplyr::inner_join(fetch, xw, by = "county_geoid")

  if (!identical(towns, "all")) {
    fetch <- dplyr::filter(fetch, NAME %in% towns)
  }
  fetch$county_geoid <- NULL
  fetch
}

## COUNTIES ----
# fetch all, then filter by arg
census_counties <- function(src, table, year, counties, state, dataset, key, sleep, ...) {
  Sys.sleep(sleep)
  xw <- county_x_state(state, counties)

  fetch <- wrap_census(src, geography = "county", table = table, year = year, state = state, dataset = dataset, key = key, ...)
  fetch$NAME <- stringr::str_remove(fetch$NAME, ", .+$") # remove , Connecticut
  fetch$NAME <- stringr::str_replace(fetch$NAME, "Planning Region", "COG")

  fetch$county_geoid <- substr(fetch$GEOID, 1, 5)
  fetch <- dplyr::inner_join(fetch, xw, by = "county_geoid")
  fetch$county_geoid <- NULL
  fetch$county <- NULL
  fetch
}

## TRACTS ----
# fetch all in the state, then filter by county or arg
census_tracts <- function(src, table, year, tracts, counties, state, dataset, key, sleep, ...) {
  Sys.sleep(sleep)

  fetch <- wrap_census(src, geography = "tract", table = table, year = year, state = state, dataset = dataset, key = key, ...)

  if (identical(tracts, "all")) {
    xw <- county_x_state(state, counties)
  } else {
    xw <- county_x_state(state, "all")
    fetch <- dplyr::filter(fetch, GEOID %in% tracts)
  }
  fetch$county_geoid <- substr(fetch$GEOID, 1, 5)
  fetch <- dplyr::inner_join(fetch, xw, by = "county_geoid")
  fetch$county_geoid <- NULL
  fetch$NAME <- fetch$GEOID
  fetch
}

## BLOCKGROUPS ----
# fetch all in the state, then filter by county or arg
census_blockgroups <- function(src, table, year, blockgroups, counties, state, dataset, key, sleep, ...) {
  Sys.sleep(sleep)

  fetch <- wrap_census(src, geography = "block group", table = table, year = year, state = state, dataset = dataset, key = key, ...)

  if (identical(blockgroups, "all")) {
    xw <- county_x_state(state, counties)
  } else {
    xw <- county_x_state(state, "all")
    fetch <- dplyr::filter(fetch, GEOID %in% blockgroups)
  }
  fetch$county_geoid <- substr(fetch$GEOID, 1, 5)
  fetch <- dplyr::inner_join(fetch, xw, by = "county_geoid")
  fetch$county_geoid <- NULL
  fetch$NAME <- fetch$GEOID
  fetch
}

## STATE ----
# fetch all, then filter
census_state <- function(src, table, year, state, dataset, key, sleep, ...) {
  Sys.sleep(sleep)
  fetch <- wrap_census(src, geography = "state", table = table, year = year, state = NULL, dataset = dataset, key = key, ...)
  fetch <- dplyr::filter(fetch, GEOID == state)
  fetch
}

## REGIONS ----
# fetch all towns, then filter by region & aggregate
# needs name of estimate/value column
census_regions <- function(src, table, year, regions, state, value, dataset, key, sleep, ...) {
  Sys.sleep(sleep)

  # get unique regions but keep names
  regions <- regions[unique(names(regions))]

  region_df <- tibble::enframe(regions, value = "town")
  region_df <- tidyr::unnest(region_df, town)
  fetch <- census_towns(src, table, year, "all", "all", state, dataset, key, 0, ...)
  fetch <- dplyr::inner_join(fetch, region_df, by = c("NAME" = "town"))
  fetch <- dplyr::group_by(fetch, state, NAME = name, variable)
  if ("moe" %in% names(fetch)) {
    fetch <- dplyr::summarise(fetch,
                              dplyr::across({{ value }}, sum),
                              moe = round(tidycensus::moe_sum(moe, {{ value }})))
  } else {
    fetch <- dplyr::summarise(fetch,
                              dplyr::across({{ value }}, sum))
  }
  fetch <- dplyr::ungroup(fetch)
  fetch
}

## NEIGHBORHOODS ----
# fetch tracts or bgs, then filter by nhood table & aggregate
# let counties be independent of neighborhoods
# needs name of estimate/value column
# switch nhood col names to strings instead of bare
census_nhood <- function(src, table, year, nhood_data, state, name, geoid, weight, is_tract, value, dataset, key, sleep, ...) {
  Sys.sleep(sleep)
  if (is_tract) {
    fetch <- census_tracts(src, table, year, "all", "all", state, dataset, key, 0, ...)
  } else {
    fetch <- census_blockgroups(src, table, year, "all", "all", state, dataset, key, 0, ...)
  }
  fetch <- dplyr::inner_join(nhood_data, fetch, by = stats::setNames("GEOID", geoid))
  fetch <- dplyr::group_by(fetch, dplyr::across(c(state, county, tidyselect::any_of(name), variable)))

  weight_col <- rlang::sym(weight)
  if ("moe" %in% names(fetch)) {
    fetch <- dplyr::summarise(fetch,
                              {{ value }} := round(sum({{ value }} * {{ weight_col }})),
                              moe = round(tidycensus::moe_sum(moe, {{ value }} * {{ weight_col }})))
  } else {
    fetch <- dplyr::summarise(fetch,
                              {{ value }} := round(sum({{ value }} * {{ weight_col }})))
  }
  fetch <- dplyr::ungroup(fetch)
  fetch
}

## MSAs ----
# fetch all in us, then filter
census_msa <- function(src, table, year, new_england, dataset, key, sleep, ...) {
  Sys.sleep(sleep)
  if (year < 2015) {
    cli::cli_inform("Note: OMB changed MSA boundaries around 2015. These might not match the ones you're expecting.")
  }
  fetch <- wrap_census(src, geography = "metropolitan statistical area/micropolitan statistical area", table = table, year = year, state = NULL, dataset = dataset, key = key, ...)
  if (new_england) {
    ne_msa <- dplyr::filter(cwi::msa, region == "New England")
    fetch <- dplyr::semi_join(fetch, ne_msa, by = c("GEOID" = "geoid"))
  }
  fetch
}

## PUMAs ----
# fetch all in state, then filter like tracts (only available for ACS)
census_pumas <- function(src, table, year, pumas, counties, state, dataset, key, sleep, ...) {
  Sys.sleep(sleep)

  fetch <- wrap_census(src, geography = "public use microdata area", table = table, year = year, state = state, dataset = dataset, key = key, ...)

  if (identical(pumas, "all")) {
    xw <- county_x_state(state, counties)
  } else {
    # joining with county_x_state doesn't work here for 2022 because pumas aren't subsets of counties anymore
    xw <- county_x_state(state, "all")
    fetch <- dplyr::filter(fetch, GEOID %in% pumas)
  }

  fetch$county_geoid <- substr(fetch$GEOID, 1, 5)

  # don't filter if CT in 2022+
  if (!(year >= 2022 & state == "09")) {
    fetch <- dplyr::inner_join(fetch, xw, by = "county_geoid")
  }
  fetch$county_geoid <- NULL
  fetch$NAME <- fetch$GEOID
  fetch
}

## US ----
# fetch
census_us <- function(src, table, year, dataset, key, sleep, ...) {
  Sys.sleep(sleep)
  fetch <- wrap_census(src, geography = "us", table = table, year = year, state = NULL, dataset = dataset, key = key, ...)
  fetch
}