Sample provided by Shuyu Jin (geojsy@umd.edu)
Overview
The US Department of Housing and Urban Development maintains both Fair Market Rents (FMR) and Income Limits (IL) programs which are crucial for determining eligibility for assistance dollars in the US. Provided below is an example of querying both FMR and IL as well as mapping them using the leaflet R library.
Loading in the necessary libraries
To improve performance, use tigris caching.
options(tigris_use_cache = TRUE)Reading in data
Read in the Fair Markets Rent for counties in the year 2021 as well as the shape files needed to map.
md_counties_2021_fmr <- hud_fmr_state_counties(state = 'MD', year = '2021') Get county data for the state of Maryland.
md_counties <- hud_state_counties("MD")Query for every county and get their Income Limits data using the rhud package.
md_counties_2021_il <- hud_il(md_counties$fips_code)
#Find unique column names and keep only unique column names
unique_names <- unique(colnames(md_counties_2021_il))
md_counties_2021_il_unique <- md_counties_2021_il[unique_names]Download the shape files for counties in the US and obtain consistent projection.
county_shapefile <- tigris::counties(state = NULL, cb = FALSE,
resolution = "500k", year = 2021) %>%
sf::st_transform('+proj=longlat +datum=WGS84')Filter the counties to those only in Maryland.
md_county_shapefile <- county_shapefile[county_shapefile$STATEFP == 24, ]
md_county_shapefile$fullFips <- paste0(as.character(md_county_shapefile$STATEFP),
as.character(md_county_shapefile$COUNTYFP),
"99999")Merging of shapefiles and data
Merge the shape file with the FMR and IL data.
md_county_fmr_merged <- tigris::geo_join(md_county_shapefile,
md_counties_2021_fmr,
by_sp = "fullFips",
by_df = "fips_code",
how = "inner")
md_county_il_merged <- tigris::geo_join(md_county_shapefile,
md_counties_2021_il_unique,
by_sp = "fullFips",
by_df = "query",
how = "inner")Leaflet Mapping
Create the pallete for coloring the overlayed shape file. The scale used corresponds to Efficiency data and Median Income data.
pal_md_fmr <- colorNumeric(
palette = "Greens",
domain = as.numeric(md_county_fmr_merged$Efficiency))
pal_md_il <- colorNumeric(
palette = "Purples",
domain = as.numeric(md_county_il_merged$median_income))Create the county level, efficiency, one bedroom, two bedroom, three bedroom four bedroom label to appear when hovering using the FMR overlay.
label_fmr <- paste0(
"County: ", md_county_fmr_merged$NAME, "<br/>",
"Efficiency: ", scales::dollar(as.numeric(md_county_fmr_merged$Efficiency)), "<br/>",
"One Bedroom: ", scales::dollar(as.numeric(md_county_fmr_merged$`One-Bedroom`)), "<br/>",
"Two Bedroom: ", scales::dollar(as.numeric(md_county_fmr_merged$`Two-Bedroom`)), "<br/>",
"Three Bedroom: ", scales::dollar(as.numeric(md_county_fmr_merged$`Three-Bedroom`)), "<br/>",
"Four Bedroom: ", scales::dollar(as.numeric(md_county_fmr_merged$`Four-Bedroom`))) %>%
lapply(htmltools::HTML)Create the county level, median income, 1 person family low/very low/extremely low income limits label to appear when hovering using the IL overlay
label_il_p1 <- paste0(
"County: ", md_county_il_merged$NAME, "<br/>",
"Median Income: ", scales::dollar(as.numeric(md_county_il_merged$median_income)), "<br/>",
"1 Person Family Low (80%) Income Limits: ", scales::dollar(as.numeric(md_county_il_merged$low.il80_p1)), "<br/>",
"1 Person Family Very Low (50%) Income Limits: ", scales::dollar(as.numeric(md_county_il_merged$very_low.il50_p1)), "<br/>",
"1 Person Family Extremely Low (30%) Income Limits: ", scales::dollar(as.numeric(md_county_il_merged$extremely_low.il30_p1))) %>%
lapply(htmltools::HTML)Create the county level, median income, 2 person family low/very low/extremely low income limits label to appear when hovering using the IL overlay
label_il_p2 <- paste0(
"County: ", md_county_il_merged$NAME, "<br/>",
"Median Income: ", scales::dollar(as.numeric(md_county_il_merged$median_income)), "<br/>",
"2 Person Family Low (80%) Income Limits: ", scales::dollar(as.numeric(md_county_il_merged$low.il80_p2)), "<br/>",
"2 Person Family Very Low (50%) Income Limits: ", scales::dollar(as.numeric(md_county_il_merged$very_low.il50_p2)), "<br/>",
"2 Person Family Extremely Low (30%) Income Limits: ", scales::dollar(as.numeric(md_county_il_merged$extremely_low.il30_p2))) %>%
lapply(htmltools::HTML)Create the county level, median income, 3 person family low/very low/extremely low income limits label to appear when hovering using the IL overlay
label_il_p3 <- paste0(
"County: ", md_county_il_merged$NAME, "<br/>",
"Median Income: ", scales::dollar(as.numeric(md_county_il_merged$median_income)), "<br/>",
"3 Person Family Low (80%) Income Limits: ", scales::dollar(as.numeric(md_county_il_merged$low.il80_p3)), "<br/>",
"3 Person Family Very Low (50%) Income Limits: ", scales::dollar(as.numeric(md_county_il_merged$very_low.il50_p3)), "<br/>",
"3 Person Family Extremely Low (30%) Income Limits: ", scales::dollar(as.numeric(md_county_il_merged$extremely_low.il30_p3))) %>%
lapply(htmltools::HTML)Create the county level, median income, 4 person family low/very low/extremely low income limits label to appear when hovering using the IL overlay
label_il_p4 <- paste0(
"County: ", md_county_il_merged$NAME, "<br/>",
"Median Income: ", scales::dollar(as.numeric(md_county_il_merged$median_income)), "<br/>",
"4 Person Family Low (80%) Income Limits: ", scales::dollar(as.numeric(md_county_il_merged$low.il80_p4)), "<br/>",
"4 Person Family Very Low (50%) Income Limits: ", scales::dollar(as.numeric(md_county_il_merged$very_low.il50_p4)), "<br/>",
"4 Person Family Extremely Low (30%) Income Limits: ", scales::dollar(as.numeric(md_county_il_merged$extremely_low.il30_p4))) %>%
lapply(htmltools::HTML)Create the county level, median income, 5 person family low/very low/extremely low income limits label to appear when hovering using the IL overlay
label_il_p5 <- paste0(
"County: ", md_county_il_merged$NAME, "<br/>",
"Median Income: ", scales::dollar(as.numeric(md_county_il_merged$median_income)), "<br/>",
"5 Person Family Low (80%) Income Limits: ", scales::dollar(as.numeric(md_county_il_merged$low.il80_p5)), "<br/>",
"5 Person Family Very Low (50%) Income Limits: ", scales::dollar(as.numeric(md_county_il_merged$very_low.il50_p5)), "<br/>",
"5 Person Family Extremely Low (30%) Income Limits: ", scales::dollar(as.numeric(md_county_il_merged$extremely_low.il30_p5))) %>%
lapply(htmltools::HTML)Using the leaflet package, plot the county level map of Fair Markets Rents and Income Limits in the state of Maryland.
# The legends overlap with the zoom control buttons, need to move these controls.
leaflet(width = "100%", options = leafletOptions(zoomControl = FALSE)) %>%
htmlwidgets::onRender("function(el, x){
L.control.zoom({position: 'topright'}).addTo(this)
}")%>%
addProviderTiles("CartoDB") %>%
addPolygons(data = md_county_fmr_merged, fillColor = ~pal_md_fmr(as.numeric(Efficiency)),
weight = 2,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7,
highlight = highlightOptions(weight = 2,
color = "#666",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE),
label = label_fmr,
group = "Fair Markets Rent") %>%
addPolygons(data = md_county_il_merged, fillColor = ~pal_md_il(as.numeric(median_income)),
weight = 2,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7,
highlight = highlightOptions(weight = 2,
color = "#666",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE),
label = label_il_p1,
group = "Income Limits-1 person") %>%
addPolygons(data = md_county_il_merged, fillColor = ~pal_md_il(as.numeric(median_income)),
weight = 2,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7,
highlight = highlightOptions(weight = 2,
color = "#666",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE),
label = label_il_p2,
group = "Income Limits-2 person") %>%
addPolygons(data = md_county_il_merged, fillColor = ~pal_md_il(as.numeric(median_income)),
weight = 2,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7,
highlight = highlightOptions(weight = 2,
color = "#666",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE),
label = label_il_p3,
group = "Income Limits-3 person") %>%
addPolygons(data = md_county_il_merged, fillColor = ~pal_md_il(as.numeric(median_income)),
weight = 2,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7,
highlight = highlightOptions(weight = 2,
color = "#666",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE),
label = label_il_p4,
group = "Income Limits-4 person") %>%
addPolygons(data = md_county_il_merged, fillColor = ~pal_md_il(as.numeric(median_income)),
weight = 2,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7,
highlight = highlightOptions(weight = 2,
color = "#666",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE),
label = label_il_p5,
group = "Income Limits-5 person") %>%
addLayersControl(overlayGroups = c("Fair Markets Rent", "Income Limits-1 person", "Income Limits-2 person", "Income Limits-3 person", "Income Limits-4 person","Income Limits-5 person"), baseGroups = "CartoDB") %>%
# add legend
addLegend("bottomright",
pal = pal_md_fmr,
values = as.numeric(md_county_fmr_merged$Efficiency),
opacity = 0.7,
title = htmltools::HTML("Fair Markets Rent <br>
by County"), group = "Fair Markets Rent") %>%
addLegend("bottomleft",
pal = pal_md_il,
values = as.numeric(md_county_il_merged$median_income),
opacity = 0.7,
title = htmltools::HTML("Income Limits <br>
by County"), group = "Income Limits") %>%
setView(lat = 39, lng = -77, zoom = 6)