midterms

Interactive Map

Here is a interactive map that shows the Nashville/surrounding areas of rent, using a colorful color pallet

CODE:

# Getting and loading required packages

if (!require("tidyverse"))
  install.packages("tidyverse")
if (!require("openxlsx"))
  install.packages("openxlsx")
if (!require("gtExtras"))
  install.packages("gtExtras")
if (!require("leafpop"))
  install.packages("leafpop")
if (!require("sf"))
  install.packages("sf")
if (!require("mapview"))
  install.packages("mapview")
if (!require("RColorBrewer"))
  install.packages("RColorBrewer")
if (!require("tidycensus"))
  install.packages("tidycensus")

library(tidyverse)
library(openxlsx)
library(gtExtras)
library(readxl)
library(sf)
library(mapview)
library(leafpop)
library(RColorBrewer)
library(tidycensus)

# Reading data from:
# https://www.huduser.gov/portal/datasets/fmr/fmr2025/fy2025_safmrs.xlsx
# Note that you are downloading the 2025 data. We have been working with 2024 data.
# The data frame should have 51,899 observations of 18 variables

download.file("https://www.huduser.gov/portal/datasets/fmr/fmr2025/fy2025_safmrs.xlsx", "rent.xlsx", mode = "wb")

FMR <- read_xlsx(path = "rent.xlsx", .name_repair = "universal")

# Making a list of Nashville-area ZIP codes

ZIPList <- c(
  "37135",
  "37215",
  "37064",
  "37060",
  "37014",
  "37122",
  "37027",
  "37046",
  "37221",
  "37153",
  "37210",
  "37202",
  "37024",
  "37218",
  "37062",
  "37179",
  "37025",
  "37206",
  "37065",
  "37214",
  "37067",
  "37246",
  "37068",
  "37167",
  "37069",
  "37189",
  "37070",
  "37204",
  "37072",
  "37208",
  "37076",
  "37212",
  "37080",
  "37216",
  "37085",
  "37020",
  "37086",
  "38476",
  "37089",
  "37160",
  "37090",
  "37174",
  "37115",
  "37180",
  "37116",
  "37201",
  "37118",
  "37203",
  "37015",
  "37205",
  "37127",
  "37207",
  "37128",
  "37209",
  "37129",
  "37211",
  "37130",
  "37213",
  "37220",
  "37037",
  "37222",
  "37217",
  "37228",
  "37219",
  "37232",
  "37013",
  "37131",
  "37224",
  "37132",
  "37229",
  "37133",
  "37236",
  "37238",
  "37240",
  "37243",
  "37138",
  "38401",
  "37143",
  "37011",
  "37149"
)

# Filtering for Nashville-area ZIP codes and
# selecting columns of interest
# FMR_Nash data frame should have 80 observations of six variables

FMR_Nash <- FMR %>%
  filter(ZIP.Code %in% ZIPList) %>%
  select(ZIP.Code, SAFMR.0BR, SAFMR.1BR, SAFMR.2BR, SAFMR.3BR, SAFMR.4BR) %>% 
  distinct()

# Renaming the columns

colnames(FMR_Nash) <- c("ZIP", "Studio", "BR1", "BR2", "BR3", "BR4")

# Averaging estimates

FMR_Nash <- FMR_Nash %>%
  mutate(ZIP_Average = (Studio + BR1 + BR2 + BR3 + BR4) / 5)

# Sorting in descending order by ZIP_Average

FMR_Nash <- FMR_Nash %>%
  arrange(desc(ZIP_Average))

# Finding the average of the ZIP_Average values

Average_ZIP_Average <- mean(FMR_Nash$ZIP_Average)

Average_ZIP_Average

# Recoding 

FMR_Nash <- FMR_Nash %>%
  mutate(
    Rent_Category = case_when(
      ZIP_Average > Average_ZIP_Average ~ "Above average",
      ZIP_Average == Average_ZIP_Average ~ "Average",
      ZIP_Average < Average_ZIP_Average ~ "Below average",
      .default = "Error"))

# Showing the data as a table

FMR_Nash_table <- gt(FMR_Nash) %>% 
  tab_header("Nashville-area FMR, by size and ZIP") %>%
  cols_align(align = "left") %>%
  gt_theme_538

FMR_Nash_table

Summary_Nash <- FMR_Nash %>% 
  group_by(Rent_Category) %>% 
  summarize(Average = mean(ZIP_Average))

# Sorting the Summary_BR3 file in descending order

Summary_Nash <- Summary_Nash %>% 
  arrange(desc(Average))

# Grouping and summarizing

Summary_Nash <- FMR_Nash %>% 
  group_by(Rent_Category) %>% 
  summarize(Count = n(),
            Minimum = min(ZIP_Average),
            Average = round(mean(ZIP_Average), 0),
            Maximum = max(ZIP_Average))

# Making the table

Summary_Nash_table <- gt(Summary_Nash) %>% 
  tab_header("Nashville stats, by rent category") %>%
  cols_align(align = "left") %>%
  gt_theme_538

# Showing the table

Summary_Nash_table

# Redownloading, unzipping and importing the ZIP code map file

download.file(
  "https://www2.census.gov/geo/tiger/GENZ2020/shp/cb_2020_us_zcta520_500k.zip",
  "ZCTAs2020.zip"
)

unzip("ZCTAs2020.zip")

ZCTAMap <- read_sf("cb_2020_us_zcta520_500k.shp")

# Merging the rent data and ZIP code map

FMR_Nash$ZIP <- as.character(FMR_Nash$ZIP)

FMR_Nash_Map <- left_join(FMR_Nash, ZCTAMap, by = c("ZIP" = "ZCTA5CE20"))

FMR_Nash_Map <- FMR_Nash_Map %>%
  select(-c(AFFGEOID20, GEOID20, NAME20, LSAD20, ALAND20, AWATER20))

FMR_Nash_Map <- st_as_sf(FMR_Nash_Map)

# Transmitting API key

census_api_key("32a6d157cbd9ca98ee8b0dcaf65290d150813e2b")

# Fetching the Census data

Census_Data <- get_acs(
  geography = "zcta",
  variables = c("DP04_0047", "DP04_0045"),
  year = 2023,
  survey = "acs5",
  output = "wide",
  geometry = FALSE
)

# Making better column names

Census_Data <- Census_Data %>% 
  rename(c("Rentals" = "DP04_0047E",
           "Rentals_MOE" = "DP04_0047M",
           "Households" = "DP04_0045E",
           "Households_MOE" = "DP04_0045M"))

# A peek at the data

glimpse(Census_Data)

# Merging the rent data and ZIP code map

FMR_Nash$ZIP <- as.character(FMR_Nash$ZIP)

FMR_Nash_Map <- left_join(FMR_Nash, ZCTAMap, by = c("ZIP" = "ZCTA5CE20"))

FMR_Nash_Map <- FMR_Nash_Map %>%
  select(-c(AFFGEOID20, GEOID20, NAME20, LSAD20, ALAND20, AWATER20))

FMR_Nash_Map <- st_as_sf(FMR_Nash_Map)

# Merging FMR_RuCo_Map and Census_Data

FMR_Nash_Map <- left_join(FMR_Nash_Map, Census_Data, by = c("ZIP" = "GEOID"))

# Mapping by ZIP code

ZIP_Map <- mapview(
  FMR_Nash_Map,
  zcol = "ZIP_Average",
  col.regions = brewer.pal(43, "YlOrRd"),
  layer.name = "Average rent",
  popup = popupTable(
    FMR_Nash_Map,
    feature.id = FALSE,
    row.numbers = FALSE,
    zcol = c("ZIP", "Studio", "BR1", "BR2", "BR3", "BR4",
             "Rentals", "Rentals_MOE", "Households", "Households_MOE")
  )
)

# Showing the map
FMR_Nash_table
Summary_Nash_table
ZIP_Map