NYC ZCTA Mapping
Robin Hart
November 16th, 2022
Load the Data
PPP Loans Dataset
#nyc_ratio_perloan <- read_dta('~/NYC extract with zcta and codes and ratios.dta')
nyc_ratio_perzcta <- read_dta('~/NYC CBSA ZCTA data ordered.dta')
nyc_ratio_perzcta_select <- nyc_ratio_perzcta %>%
select(zcta, loan_notsusp_tobizratio, MAJMIN, POV20noCollTract, POP, ZCTAinNYC)Tidycensus Dataset (with Geometries)
options(tigris_use_cache = TRUE)
nyc_tidycensus_pull <- get_acs(
state = "NY",
geography = "zcta",
variables = "B00001_001",
geometry = TRUE,
year = 2018
)
# grab only the relevant zctas...
nyc_tidycensus_filt <- nyc_tidycensus_pull %>%
filter(GEOID %in% nyc_ratio_perzcta$zcta)
nyc_map_loan_merge <- nyc_tidycensus_filt %>%
left_join(nyc_ratio_perzcta_select, by = c("GEOID" = "zcta"))
#nyc_map_loan_merge$loan_notsusp_tobizratiotransforming loan ratios into a categorical split
- Cutoffs for a four category split would be .54, .72 and .90.
- Above .9 or .82 appear to be “success cases” at least as tapped by high ratios
- Omit plotting the zctas with ratios above 2 and/or zero population. Leaves us with 181 ZCTAs.
nyc_map_ready <- nyc_map_loan_merge %>%
filter(POP != 0 & loan_notsusp_tobizratio < 2 & ZCTAinNYC == 1) %>%
mutate(loan_ratio_cat = case_when(loan_notsusp_tobizratio < 0.54 ~ 1,
loan_notsusp_tobizratio >= 0.54 & loan_notsusp_tobizratio < 0.72 ~ 2,
loan_notsusp_tobizratio >= 0.72 & loan_notsusp_tobizratio < 0.9 ~ 3,
loan_notsusp_tobizratio >= 0.9 ~ 4))Maps
Loan Ratios
nyc_map_ready %>%
ggplot(aes(fill = loan_ratio_cat)) +
geom_sf(color = "black", size = .2) +
scale_fill_viridis_c(option = "magma", direction = -1) +
robins_ggplot_theme() +
labs(fill = "\nRatio of Loans to \nBusinesses, by SD Cutoffs",
title = "Loan Ratios per ZCTA in NYC")
interactive
library(leaflet)
pal_gen_ratios <- colorNumeric(palette = "viridis",
domain = nyc_map_ready$loan_ratio_cat,
reverse = TRUE)
gen_ratios_content <- paste("<b>", nyc_map_ready$GEOID,
"</b></br><em>", "Ratio of Non-Suspicious Loans to Number of Businesses:",
"</em>", round(nyc_map_ready$loan_notsusp_tobizratio, digits = 3))
nyc_map_ready %>%
leaflet(options = leafletOptions(minZoom = 5, maxZoom = 12)) %>%
addPolygons(popup = ~gen_ratios_content, fillColor = ~pal_gen_ratios(loan_ratio_cat),
stroke = TRUE, fillOpacity = 0.9, color = "black",
opacity = 1, weight = 1.5) %>%
addLegend("bottomright", pal = pal_gen_ratios,
values = ~loan_ratio_cat,
title = "Ratio of Loans to \nBusinesses, by SD Cutoffs",
opacity = 1)Faceted Loan Ratios by Race & Poverty
majmin = 1 & pov = 1, majmin = 1 & pov = 0, majmin = 0 & pov = 1, majmin = 0 & pov = 0
nyc_map_ready %>%
mutate(demographic_splits = case_when(MAJMIN == 1 & POV20noCollTract == 1 ~ "Racial Minority Majority & High Poverty",
MAJMIN == 1 & POV20noCollTract == 0 ~ "Racial Minority Majority & Low Poverty",
MAJMIN == 0 & POV20noCollTract == 1 ~ "White Majority & High Poverty",
MAJMIN == 0 & POV20noCollTract == 0 ~ "White Majority & Low Poverty")) %>%
ggplot(aes(fill = loan_ratio_cat)) +
geom_sf(color = "black", size = .2) +
facet_wrap(~demographic_splits) +
scale_fill_viridis_c(option = "magma", direction = -1) +
robins_facet_theme() +
labs(fill = "\nRatio of Loans to \nBusinesses, by SD Cutoffs",
title = "Loan Ratios per ZCTA in NYC")
Colored Loan Ratios by Race & Poverty
nyc_map_ready_demographics <- nyc_map_ready %>%
mutate(demographic_splits = case_when(MAJMIN == 1 & POV20noCollTract == 1 ~ "Racial Minority Majority & High Poverty",
MAJMIN == 1 & POV20noCollTract == 0 ~ "Racial Minority Majority & Low Poverty",
MAJMIN == 0 & POV20noCollTract == 1 ~ "White Majority & High Poverty",
MAJMIN == 0 & POV20noCollTract == 0 ~ "White Majority & Low Poverty")) %>%
mutate(loan_ratio_cat = case_when(loan_notsusp_tobizratio < 0.54 ~ 10,
loan_notsusp_tobizratio >= 0.54 & loan_notsusp_tobizratio < 0.72 ~ 300,
loan_notsusp_tobizratio >= 0.72 & loan_notsusp_tobizratio < 0.9 ~ 600,
loan_notsusp_tobizratio >= 0.9 ~ 1000))
nyc_map_ready_demographics %>%
ggplot(aes(fill = demographic_splits, alpha = loan_ratio_cat)) +
geom_sf(color = "black", size = .2) +
scale_fill_brewer(type = "qual", palette = 2) +
robins_ggplot_theme() +
labs(fill = "Demographic Splits",
title = "Loan Ratios per ZCTA in NYC",
alpha = "\nRatio of Loans to \nBusinesses, by SD Cutoffs")
interactive
nyc_map_ready_demographics <- nyc_map_ready %>%
mutate(demographic_splits = case_when(MAJMIN == 1 & POV20noCollTract == 1 ~ "Racial Minority Majority & High Poverty",
MAJMIN == 1 & POV20noCollTract == 0 ~ "Racial Minority Majority & Low Poverty",
MAJMIN == 0 & POV20noCollTract == 1 ~ "White Majority & High Poverty",
MAJMIN == 0 & POV20noCollTract == 0 ~ "White Majority & Low Poverty")) %>%
mutate(loan_ratio_cat = case_when(loan_notsusp_tobizratio < 0.54 ~ 0.1,
loan_notsusp_tobizratio >= 0.54 & loan_notsusp_tobizratio < 0.72 ~ 0.4,
loan_notsusp_tobizratio >= 0.72 & loan_notsusp_tobizratio < 0.9 ~ 0.7,
loan_notsusp_tobizratio >= 0.9 ~ 1))
pal_dem_ratios <- colorFactor(palette = c("#1b9e77", "#d95f02", "#7570b3", "#e7298a"),
domain = nyc_map_ready_demographics$demographic_splits)
dem_ratios_content <- paste("<b>", nyc_map_ready_demographics$GEOID,
"</b></br><em>", "Ratio of Non-Suspicious Loans to Number of Businesses:",
"</em>", round(nyc_map_ready_demographics$loan_notsusp_tobizratio, digits = 3),
"</br><em>", "Demographic Split:",
"</em>", nyc_map_ready_demographics$demographic_splits)
nyc_map_ready_demographics %>%
leaflet(options = leafletOptions(minZoom = 5, maxZoom = 12)) %>%
addPolygons(popup = ~dem_ratios_content, fillColor = ~pal_dem_ratios(demographic_splits),
stroke = TRUE, fillOpacity = ~loan_ratio_cat, color = "black",
opacity = 1, weight = 1.5) %>%
addLegend("bottomright", pal = pal_dem_ratios,
values = ~demographic_splits,
title = "Demographic Splits",
opacity = 1)