ERA Allocation & Rental Assistance Need

The analysis presented here appears in this blog post:

Rental Assistance Need and Federal ERA Allocation in New York State

The dataset used here is prepared separately.

The methodology and data preparation code used here is copied from previous analyses, with some updates to the underlying data. Specifically, we now use ACS 2019 1-year PUMS data (instead of 2018), and to measure employment changes we have updated for the most recent data available to use the difference between November 2019 and November 2020.

# Install required packages 

pkgs <- c(
  "tidyverse",
  "hrbrthemes",
  "rmarkdown",
  "jsonlite",
  "remotes",
  "srvyr",
  "knitr",
  "furrr",
  "gt",
  "fs",
)

install.packages(pkgs)
remotes::install_github("mikeasilva/blsAPI")

library(tidyverse) # general data manipulation and graphing
library(scales) # number formatting
library(srvyr) # survey functions
library(gt) # making tables
library(furrr) # parallel processing

# Load custom theme function to help with plotting
source("R/plot-helpers.R")

# No scientific notation in outputs
options(scipen = 999)

# To deal with the random assignment of job loss and UI takeup for individuals,
# we need to run generate the results multiple times with different random seeds
# and then average the results. To speed this up we use {furrr} to run this in
# parallel across multiple cores.
plan(multiprocess)

# The total amount of emergency rental assistance funding for NY, for calculations below.
tot_era_funds <- 1282268820.90

The total maximum state allocation for New York is $1,282,268,821. (See this PDF document from the Treasury department for details and values for other states.)

ipums_clean <- read_rds("data/ipums_clean.rds")

Repeated Iterations of Analysis

# Number of iterations to run when compiling results
ITERATIONS <- as.integer(params$iterations)

# We manage the random number generator seed directly, so we can ignore warnings from the package that handles the parallelization 
options(future.rng.onMisuse = "ignore")

In our analysis we randomly assign individuals in the data to job loss status and UI recipiency with probabilities based on the industry-specific job loss rates and the UI benefit recipiency rate. To ensure that our final results are not unduly influenced by random variation in those assignment, we repeat the analysis 100 times and average the results.

Unemployment Insurance Recipiency Rate

# Assumption about % of people who lost jobs that will receive UI benefits
UI_TAKEUP_RATE <- 0.67

Not every person who losses their job will receive unemployment insurance. The reasons for this include:

income eligibility
employment type eligibility
immigration status
administrative burden
never applying

While we can test for income eligibility in the data, we have to rely on this assumption about overall take up rate to account the other factors in our analysis.

For this analysis we are following the work from The Century Foundation and using a UI recipiency rate of 67% for New York State.

Analysis Functions

There are two functions that add UI takeup and rental assistance need variables to the clean IPUMS dataset. These are part of the steps that are repeated for many iterations of the simulations.

source("R/add-ui-and-need-vars.R")

This function takes a dataframe as created by the above add_risk_vars() function that has then been filtered to only one row per household (eg. filter(pernum == 1)), and summarizes the household level variables (using survey weights) of interest for a single month.

# Preset some arguments for cleaner code below
survey_total_ci90 <- partial(survey_total, vartype = "ci", level = 0.90)
survey_mean_ci90 <- partial(survey_mean, vartype = "ci", level = 0.90)

# When using the {srvyr} package we get separate columns for the lower and
# upper bounds of the confidence interval. This little helper function creates
# a single margin of error column.
add_moe <- function(.data) {
  .data %>%
  pivot_longer(is.numeric) %>% 
  mutate(
    value_type = case_when(
      str_detect(name, "_low") ~ "low",
      str_detect(name, "_upp") ~ "upp",
      TRUE ~ "est"
    ),
    name = str_remove(name, "(_low|_upp)")
  ) %>% 
  pivot_wider(names_from = value_type, values_from = value) %>% 
  mutate(moe_90 = upp - est) %>% 
  select(-low, -upp) %>% 
  pivot_longer(is.numeric, names_to = "value_type") %>% 
  unite(name_type, name, value_type) %>% 
  pivot_wider(names_from = name_type, values_from = value)
}

Table making helpers

We create a lot of different tables to display our results, and there are a few common tasks we need to do with them all so it’s helpful to separate this code out into small functions to use in each table.

It’s useful to have MOE columns in the tables when drafting the write up, but for displaying the final tables it is overwhelming to have so many numbers so we also want to have versions with the MOEs hidden. We’ve used R Markdown’s “parameters” feature to make it easy to render the document with or without MOE columns.

# Hide margin of error columns in tables?
HIDE_MOE <- as.logical(params$hide_moe)

# Annoyingly, you can't hide the col labels and have spanners, so we just make a
# list of all the column names and set the label to "" and plug this into
# cols_label(.list = hide_cls_list(.data))
hide_cols_list <- function(.data) {
  .data %>% 
  select(is.numeric) %>% 
  names() %>% 
  {set_names(rep("", length(.)), .)} %>% 
  as.list()
}

# {gt} has a useful function for hiding columns, so we just make a little
# helper so we can show/hide based on a boolean defined above.

hide_moe_cols <- function(.data, hide_moe = FALSE) {
  if (hide_moe) {
    cols_hide(.data, ends_with("_moe_90"))
  } else {
    .data
  }
}

# Population

summarise_pop <- function(.data, .geo) {
  .data %>% 
    as_survey_design(weights = perwt) %>% 
    group_by({{.geo}}) %>%
    summarise(pop_num = survey_total_ci90(1)) %>% 
    ungroup()
}

data_state_pop <- ipums_clean %>%
  mutate(city = "NY State") %>% 
  summarise_pop(city) %>% 
  add_moe() %>% 
  transmute(
    nys_pop_num_est = pop_num_est,
    nys_pop_num_moe_90 = pop_num_moe_90,
    nys_era_funds_num_est = tot_era_funds,
    nys_era_funds_num_moe_90 = 0
  )


pop_nys_calc <- function(.data) {
  .data %>% 
    mutate(
      pop_pct_est = pop_num_est / nys_pop_num_est, 
      pop_pct_moe_90 = tidycensus::moe_prop(pop_num_est, nys_pop_num_est, 
                                            pop_num_moe_90, nys_pop_num_moe_90),
      era_funds_num_est = (pop_pct_est*0.45)*nys_era_funds_num_est,
      era_funds_num_moe_90 = tidycensus::moe_product(pop_pct_est*0.45, nys_era_funds_num_est,
                                                     pop_pct_moe_90*0.45, nys_era_funds_num_moe_90)
    )
}

data_city_pop <- ipums_clean %>%
  filter(!is.na(city)) %>% 
  summarise_pop(city) %>% 
  add_moe() %>% 
  mutate(type = "city_pop") %>% 
  bind_cols(data_state_pop) %>% 
  pop_nys_calc() %>% 
  mutate(type = "City") %>% 
  select(
    type,
    geo = city, 
    starts_with("pop_num"),
    starts_with("pop_pct"),
    starts_with("era_funds_num")
  )

data_county_pop <- ipums_clean %>%
  filter(!is.na(county_name)) %>% 
  summarise_pop(county_name) %>% 
  add_moe() %>% 
  mutate(type = "county_pop") %>% 
  bind_cols(data_state_pop) %>% 
  pop_nys_calc() %>% 
  mutate(type = "County") %>% 
  select(
    type,
    geo = county_name, 
    starts_with("pop_num"),
    starts_with("pop_pct"),
    starts_with("era_funds_num")
  )


all_pop_table <- bind_rows(
  data_city_pop, 
  data_county_pop,
  data_state_pop %>% 
    rename_with(~str_remove(., "^nys_")) %>% 
    mutate(type = "state", geo = "New York State")
)

# Households

summarise_hhs <- function(.data, .geo) {
  .data %>% 
    filter(
      pernum == 1, # keep only one row per household
      is_renter # keep only renters
    ) %>% 
    as_survey_design(weights = hhwt) %>% 
    group_by({{.geo}}) %>%
    summarise(
      renter_hhs_num = survey_total_ci90(1),
      renter_hhs_lost_wages_num = survey_total_ci90(hh_any_risk, na.rm = TRUE),
      renter_need_ui300_num = survey_total_ci90(risk_rent_need_ui_all300, na.rm = TRUE)
    ) %>% 
    ungroup()
}

prep_hhs <- function(seed, .data) {
  set.seed(seed)
  
  data_w_need <- .data %>% 
    mutate(risk_group = runif(n()) < job_loss_pct) %>% 
    add_ui_takeup(UI_TAKEUP_RATE) %>% 
    add_need_vars()
  
  data_state_hhs <- data_w_need %>%
    mutate(state = "ny") %>% 
    summarise_hhs(state) %>% 
    mutate(type = "state_hhs")
  
  data_city_hhs <- data_w_need %>%
    filter(!is.na(city)) %>% 
    summarise_hhs(city) %>% 
    mutate(type = "city_hhs")
  
  data_county_hhs <- data_w_need %>%
    filter(!is.na(county_name)) %>% 
    summarise_hhs(county_name) %>% 
    mutate(type = "county_hhs")
  
  bind_rows(
    data_state_hhs,
    data_city_hhs,
    data_county_hhs
  ) %>% 
    mutate(seed = seed)
}

data_hhs <- seq_len(ITERATIONS) %>%
  future_map_dfr(
    .f = prep_hhs,
    .data = filter(ipums_clean, is_renter)
  )

data_hhs_mean <- data_hhs %>% 
  select(-seed) %>% 
  group_by(city, state, county_name, type) %>% 
  summarise_all(mean) %>% 
  ungroup() %>% 
  add_moe()

data_state_hhs <- data_hhs_mean %>% 
  filter(type == "state_hhs") %>% 
  select(starts_with("renter")) %>% 
  rename_with(~str_c("nys_", .))
  

hhs_nys_calc <- function(.data) {
  .data %>% 
    mutate(
    renter_hhs_pct_est = renter_hhs_num_est / nys_renter_hhs_num_est, 
    renter_hhs_pct_moe_90 = tidycensus::moe_prop(
      renter_hhs_num_est, nys_renter_hhs_num_est, 
      renter_hhs_num_moe_90, nys_renter_hhs_num_moe_90
    ),
    renter_hhs_lost_wages_pct_est = renter_hhs_lost_wages_num_est / nys_renter_hhs_lost_wages_num_est, 
    renter_hhs_lost_wages_pct_moe_90 = tidycensus::moe_prop(
      renter_hhs_lost_wages_num_est, nys_renter_hhs_lost_wages_num_est, 
      renter_hhs_lost_wages_num_moe_90, nys_renter_hhs_lost_wages_num_moe_90
    ),
    renter_need_ui300_pct_est = renter_need_ui300_num_est / nys_renter_need_ui300_num_est, 
    renter_need_ui300_pct_moe_90 = tidycensus::moe_prop(
      renter_need_ui300_num_est, nys_renter_need_ui300_num_est, 
      renter_need_ui300_num_moe_90, nys_renter_need_ui300_num_moe_90
    )
  )
}

data_city_hhs <- data_hhs_mean %>% 
  filter(type == "city_hhs") %>% 
  bind_cols(data_state_hhs) %>% 
  hhs_nys_calc() %>% 
  mutate(
    type = "City",
    geo = city
  ) %>% 
  select(
    type, geo,
    starts_with("renter_hhs_"), 
    starts_with("renter_hhs_lost_wages_"), 
    starts_with("renter_need_ui300_")
  )

data_county_hhs <- data_hhs_mean %>% 
  filter(type == "county_hhs") %>% 
  bind_cols(data_state_hhs) %>% 
  hhs_nys_calc() %>% 
  mutate(
    type = "County",
    geo = county_name
  ) %>% 
  select(
    type, geo,
    starts_with("renter_hhs_"), 
    starts_with("renter_hhs_lost_wages_"), 
    starts_with("renter_need_ui300_")
  )

all_hhs_table <- bind_rows(
  data_city_hhs, 
  data_county_hhs,
  data_state_hhs %>% 
    rename_with(~str_remove(., "^nys_")) %>%
    mutate(type = "State", geo = "New York State")
)

summary_table <- left_join(all_pop_table, all_hhs_table, by = c("type", "geo"))

table_abs <- summary_table %>% select(type, geo, contains("num"))

table_abs %>% 
  gt(rowname_col = "geo",
     groupname_col = "type") %>% 
  tab_spanner("Total Population", starts_with("pop_num")) %>% 
  tab_spanner("Renter Households", starts_with("renter_hhs_num")) %>% 
  tab_spanner(md("Renter Households<br>with Lost Wages"), starts_with("renter_hhs_lost_wages_num")) %>% 
  tab_spanner(md("Monthly Amount of Rental Assistance Need<br>(after Standard UI + $300/week)"), starts_with("renter_need_ui300_num")) %>% 
  tab_spanner(md("Allocation of Direct<br>Federal Emergency Rental Assistance<br>(45% of locality's share of state population)"), starts_with("era_funds_num")) %>% 
  cols_label(.list = hide_cols_list(table_abs)) %>%
  hide_moe_cols(HIDE_MOE) %>%  
  # highlight_total() %>%
  fmt_number(everything(), suffixing = TRUE, decimals = 0) %>% 
  fmt_number(ends_with("moe_90"), suffixing = TRUE, decimals = 0, pattern = "(+/- {x})") %>% 
  fmt_currency(contains("(funds)|(ui300)_num"), suffixing = TRUE, decimals = 0) %>% 
  fmt_currency(ends_with("_(funds)|(ui300)_num_moe_90"), suffixing = TRUE, decimals = 0, pattern = "(+/- {x})") %>% 
  tab_header(
    "Estimated absolute numbers by largest NY cities and counties",
  ) %>% 
  tab_source_note("Unemployment estimates use change between Nov 2019 and Nov 2020 by industry for NYS")

Estimated absolute numbers by largest NY cities and counties

	Total Population	Allocation of Direct Federal Emergency Rental Assistance (45% of locality's share of state population)	Renter Households	Renter Households with Lost Wages	Monthly Amount of Rental Assistance Need (after Standard UI + $300/week)

City
Albany	96K	3M	28K	4K	1M
Buffalo	246K	8M	64K	9K	2M
New York City	8M	249M	2M	315K	178M
Rochester	197K	6M	56K	8K	2M
Syracuse	128K	4M	35K	4K	1M
Yonkers	197K	6M	41K	6K	2M
County
Albany	288K	9M	54K	7K	2M
Dutchess	277K	8M	36K	6K	2M
Erie	892K	27M	141K	18K	4M
Monroe	716K	22M	115K	15K	4M
Nassau	1M	41M	87K	14K	8M
Niagara	206K	6M	27K	3K	753K
Oneida	150K	5M	23K	3K	546K
Onondaga	407K	12M	63K	8K	2M
Orange	375K	11M	44K	5K	2M
Rockland	320K	10M	32K	5K	2M
Saratoga	226K	7M	24K	4K	1M
Suffolk	1M	44M	95K	14K	8M
Westchester	940K	29M	135K	18K	10M
state
New York State	19M	1B	NA	NA	NA
Unemployment estimates use change between Nov 2019 and Nov 2020 by industry for NYS

table_pct <- summary_table %>% 
  select(type, geo, contains("pct")) %>% 
  filter(type != "state") %>% 
  mutate(direct_share = pop_pct_est * 0.45, .before = 1) %>% 
  select(-contains("wages"))

gt_table_pct <- table_pct %>%
  gt(rowname_col = "geo",
     groupname_col = "type") %>% 
  tab_spanner("Share of Total NYS Aid Direct from Fed Gov't", 
              starts_with("direct_share")) %>% 
  tab_spanner("Share of NYS Population", 
              starts_with("pop_pct")) %>% 
  tab_spanner("Share of NYS Renter Households", 
              starts_with("renter_hhs_pct")) %>% 
  # tab_spanner(md("Share of NYS Renter Households with Lost Wages"), 
  #             starts_with("renter_hhs_lost_wages_pct")) %>% 
  tab_spanner(md("Share of Estimated Need¹"), 
              starts_with("renter_need_ui300_pct")) %>% 
  cols_label(.list = hide_cols_list(table_pct)) %>%
  hide_moe_cols(HIDE_MOE) %>%  
  # highlight_total() %>%
  fmt_percent(everything(), decimals = 1) %>% 
  fmt_percent(ends_with("moe_90"), decimals = 1, pattern = "(+/- {x})") %>% 
  tab_header(
    "Estimated local share of statewide totals for largest NY cities and counties",
  ) %>% 
  tab_source_note(
    md("_Sources: US Census American Community Survey 2019 via IPUMS USA, US Bureau of Labor Statistics (BLS) Current Employment Statistics (CES)_")
    ) %>% 
  tab_source_note(
    md("¹Unemployment estimates use change between Nov 2019 and Nov 2020 by industry for NYS. For more details on methodology for estimated rental assistance need, see our [previous blog post](https://furmancenter.org/thestoop/entry/rental-assistance-need-in-five-of-new-yorks-mid-sized-cities)")
  )

gt_table_pct

Estimated local share of statewide totals for largest NY cities and counties

	Share of Total NYS Aid Direct from Fed Gov't	Share of NYS Population	Share of NYS Renter Households	Share of Estimated Need¹

City
Albany	0.2%	0.5%	0.8%	0.6%
Buffalo	0.6%	1.3%	1.9%	0.7%
New York City	19.4%	43.1%	63.2%	75.3%
Rochester	0.5%	1.0%	1.6%	0.7%
Syracuse	0.3%	0.7%	1.0%	0.5%
Yonkers	0.5%	1.0%	1.2%	1.0%
County
Albany	0.7%	1.5%	1.6%	1.0%
Dutchess	0.7%	1.5%	1.0%	0.8%
Erie	2.1%	4.7%	4.1%	1.6%
Monroe	1.7%	3.8%	3.3%	1.5%
Nassau	3.2%	7.1%	2.5%	3.5%
Niagara	0.5%	1.1%	0.8%	0.3%
Oneida	0.4%	0.8%	0.7%	0.2%
Onondaga	1.0%	2.2%	1.8%	0.9%
Orange	0.9%	2.0%	1.3%	0.8%
Rockland	0.8%	1.7%	0.9%	1.0%
Saratoga	0.5%	1.2%	0.7%	0.4%
Suffolk	3.5%	7.7%	2.7%	3.5%
Westchester	2.2%	5.0%	3.9%	4.3%
Sources: US Census American Community Survey 2019 via IPUMS USA, US Bureau of Labor Statistics (BLS) Current Employment Statistics (CES)
¹Unemployment estimates use change between Nov 2019 and Nov 2020 by industry for NYS. For more details on methodology for estimated rental assistance need, see our previous blog post

ERA Allocation & Rental Assistance Need

NYU Furman Center

2021-02-09

Repeated Iterations of Analysis

Unemployment Insurance Recipiency Rate

Analysis Functions

Table making helpers