Looking for a new place to rent in the Murfreesboro and Nashville area? Well you came to the right place. Below is the code that will produce the tables and map you will see. These tables and map show the different rental units available in their area, and seperates them based on income/ affordability. Good luck on finding your new home.

ZIP Code Affordability
Affordability Count Minimum Average Maximum
Unaffordable 63 1660 2329 3320
Data
ZIP Studio BR1 BR2 BR3 BR4 Rentals Rentals_MOE Households Households_MOE Pay Affordability
37015 1270 1330 1460 1870 2280 1708 379 7571 497 27.5 Unaffordable
37013 1630 1710 1870 2390 2910 18517 1276 40353 1310 27.5 Unaffordable
37014 1960 2060 2250 2880 3510 20 33 1250 403 27.5 Unaffordable
37020 1150 1230 1360 1810 2130 93 55 1998 265 27.5 Unaffordable
37025 1150 1170 1320 1660 2020 210 102 2607 337 27.5 Unaffordable
37027 2130 2230 2440 3120 3800 4030 564 22535 840 27.5 Unaffordable
37037 1900 1990 2180 2790 3400 395 186 3128 372 27.5 Unaffordable
37046 1600 1680 1880 2420 2870 313 185 2589 292 27.5 Unaffordable
37060 1370 1460 1600 2070 2500 113 61 1079 158 27.5 Unaffordable
37062 1470 1530 1690 2130 2620 1070 270 5025 406 27.5 Unaffordable
37064 1870 1960 2150 2750 3350 5589 656 24359 803 27.5 Unaffordable
37067 1960 2050 2250 2880 3510 6479 641 13405 867 27.5 Unaffordable
37069 2260 2370 2600 3320 4050 917 217 7125 412 27.5 Unaffordable
37072 1420 1490 1630 2080 2540 4626 519 13778 696 27.5 Unaffordable
37076 1550 1620 1780 2280 2770 8609 730 17897 865 27.5 Unaffordable
37080 1150 1170 1320 1660 2020 357 158 3056 394 27.5 Unaffordable
37085 1320 1380 1520 1940 2360 113 86 1992 302 27.5 Unaffordable
37086 1730 1820 1990 2540 3100 3434 488 12887 545 27.5 Unaffordable
37090 1430 1490 1640 2100 2550 2072 421 7916 497 27.5 Unaffordable
37115 1410 1480 1620 2070 2520 10961 681 19328 811 27.5 Unaffordable
37118 1150 1170 1320 1660 2020 55 59 424 155 27.5 Unaffordable
37122 1920 2010 2200 2810 3430 5052 585 24785 680 27.5 Unaffordable
37127 1360 1420 1560 1990 2430 1650 330 7056 523 27.5 Unaffordable
37128 1570 1640 1800 2300 2800 10523 1007 28968 1212 27.5 Unaffordable
37129 1570 1640 1800 2300 2800 8241 990 23583 1187 27.5 Unaffordable
37130 1280 1340 1470 1880 2290 11852 804 23624 927 27.5 Unaffordable
37132 1280 1340 1470 1880 2290 0 14 0 14 27.5 Unaffordable
37135 2260 2370 2600 3320 4050 577 189 7827 611 27.5 Unaffordable
37138 1510 1580 1730 2210 2700 2211 398 9708 458 27.5 Unaffordable
37143 1300 1360 1490 1900 2320 145 88 1614 207 27.5 Unaffordable
37149 1150 1180 1320 1660 2020 81 69 937 198 27.5 Unaffordable
37153 1670 1750 1920 2450 2990 281 175 1982 326 27.5 Unaffordable
37160 1150 1170 1320 1660 2020 4933 518 14238 493 27.5 Unaffordable
37167 1430 1500 1640 2100 2560 8823 720 23225 773 27.5 Unaffordable
37174 1760 1810 2050 2610 3070 5061 597 19512 852 27.5 Unaffordable
37179 2130 2230 2440 3120 3800 788 211 5918 546 27.5 Unaffordable
37180 1150 1170 1320 1660 2020 100 83 1308 189 27.5 Unaffordable
37189 1290 1350 1480 1890 2310 348 184 1505 345 27.5 Unaffordable
37201 2060 2150 2360 3020 3680 516 168 799 224 27.5 Unaffordable
37203 1730 1820 1990 2540 3100 11852 1016 14683 899 27.5 Unaffordable
37204 1990 2080 2280 2910 3550 3200 349 7322 518 27.5 Unaffordable
37205 1940 2030 2230 2850 3470 3784 611 11753 620 27.5 Unaffordable
37206 1600 1680 1840 2350 2870 6507 563 13079 662 27.5 Unaffordable
37207 1260 1320 1450 1850 2260 8000 960 18067 971 27.5 Unaffordable
37208 1640 1720 1880 2400 2930 6572 600 9805 624 27.5 Unaffordable
37209 1700 1780 1950 2490 3040 10641 772 20049 901 27.5 Unaffordable
37210 1380 1440 1580 2020 2460 5901 656 8464 598 27.5 Unaffordable
37211 1550 1620 1780 2280 2770 16612 983 32716 1101 27.5 Unaffordable
37212 1590 1660 1820 2330 2840 4022 498 6822 580 27.5 Unaffordable
37213 1590 1670 1830 2340 2850 0 14 0 14 27.5 Unaffordable
37214 1740 1820 2000 2560 3120 5541 609 14795 682 27.5 Unaffordable
37215 1920 2010 2200 2810 3430 2505 497 10341 666 27.5 Unaffordable
37216 1580 1650 1810 2310 2820 2719 337 9123 621 27.5 Unaffordable
37217 1550 1620 1780 2280 2770 7861 688 13411 666 27.5 Unaffordable
37218 1380 1440 1580 2020 2460 2170 456 6227 516 27.5 Unaffordable
37219 2130 2230 2440 3120 3800 1363 332 1704 361 27.5 Unaffordable
37220 2150 2230 2470 3120 3840 193 98 2213 256 27.5 Unaffordable
37221 1920 2010 2200 2810 3430 5827 632 19935 848 27.5 Unaffordable
37228 1510 1580 1730 2210 2700 1791 352 1812 339 27.5 Unaffordable
37232 1540 1610 1770 2260 2760 0 14 0 14 27.5 Unaffordable
37238 1540 1610 1770 2260 2760 0 14 0 14 27.5 Unaffordable
38401 1150 1170 1320 1660 2020 7942 602 26524 686 27.5 Unaffordable
38476 1180 1220 1390 1770 2210 40 47 324 165 27.5 Unaffordable
 
## Simple feature collection with 63 features and 12 fields
## Geometry type: MULTIPOLYGON
## Dimension:     XY
## Bounding box:  xmin: -87.4709 ymin: 35.313 xmax: -86.07638 ymax: 36.43251
## Geodetic CRS:  WGS 84
## # A tibble: 63 × 13
##    ZIP   Studio   BR1   BR2   BR3   BR4                         geometry Rentals
##  * <chr>  <dbl> <dbl> <dbl> <dbl> <dbl>               <MULTIPOLYGON [°]>   <dbl>
##  1 37015   1270  1330  1460  1870  2280 (((-87.25392 36.37339, -87.2488…    1708
##  2 37013   1630  1710  1870  2390  2910 (((-86.71298 36.03353, -86.7118…   18517
##  3 37014   1960  2060  2250  2880  3510 (((-86.73069 35.89813, -86.7286…      20
##  4 37020   1150  1230  1360  1810  2130 (((-86.54383 35.65848, -86.5427…      93
##  5 37025   1150  1170  1320  1660  2020 (((-87.46866 35.94749, -87.4650…     210
##  6 37027   2130  2230  2440  3120  3800 (((-86.89156 36.03575, -86.8891…    4030
##  7 37037   1900  1990  2180  2790  3400 (((-86.52566 35.72771, -86.5245…     395
##  8 37046   1600  1680  1880  2420  2870 (((-86.83737 35.74659, -86.8359…     313
##  9 37060   1370  1460  1600  2070  2500 (((-86.69499 35.7465, -86.68441…     113
## 10 37062   1470  1530  1690  2130  2620 (((-87.21861 36.01901, -87.2158…    1070
## # ℹ 53 more rows
## # ℹ 5 more variables: Rentals_MOE <dbl>, Households <dbl>,
## #   Households_MOE <dbl>, FillColor <chr>, HoverLabel <chr>
```# ----------------------------------------------------------
# Step 1: Install & load required packages
# ----------------------------------------------------------
if (!require("tidyverse"))
  install.packages("tidyverse")
if (!require("gt"))
  install.packages("gt")
if (!require("leaflet"))
  install.packages("leaflet")
if (!require("leafpop"))
  install.packages("leafpop")
if (!require("sf"))
  install.packages("sf")
if (!require("RColorBrewer"))
  install.packages("RColorBrewer")
if (!require("classInt"))
  install.packages("classInt")
if (!require("scales"))
  install.packages("scales")
if (!require("htmlwidgets"))
  install.packages("htmlwidgets")
if (!require("tidycensus"))
  install.packages("tidycensus")

library(tidyverse)
library(gt)
library(sf)
library(leaflet)
library(leafpop)
library(RColorBrewer)
library(classInt)
library(scales)
library(htmlwidgets)
library(tidycensus)

# ----------------------------------------------------------
# Step 2: 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"
)

# ----------------------------------------------------------
# Step 3: Download HUD SAFMR Excel file
# ----------------------------------------------------------
download.file(
  "https://www.huduser.gov/portal/datasets/fmr/fmr2026/fy2026_safmrs.xlsx",
  "rent.xlsx",
  mode = "wb"
)

# ----------------------------------------------------------
# Step 4: Read Excel data
# ----------------------------------------------------------
FMR_Area <- readxl::read_xlsx(path = "rent.xlsx",
                              .name_repair = "universal")

# ----------------------------------------------------------
# Step 5: Filter FMR data for ZIPList
# ----------------------------------------------------------
FMR_Area <- FMR_Area %>%
  transmute(
    ZIP    = ZIP.Code,
    Studio = SAFMR.0BR,
    BR1    = SAFMR.1BR,
    BR2    = SAFMR.2BR,
    BR3    = SAFMR.3BR,
    BR4    = SAFMR.4BR
  ) %>%
  filter(ZIP %in% ZIPList) %>%
  distinct()

# ----------------------------------------------------------
# Step 6: Download and unzip ZCTA shapefile
# ----------------------------------------------------------
download.file(
  "https://www2.census.gov/geo/tiger/GENZ2020/shp/cb_2020_us_zcta520_500k.zip",
  "ZCTAs2020.zip",
  mode = "wb"
)
unzip("ZCTAs2020.zip")

# ----------------------------------------------------------
# Step 7: Load ZCTA shapefile
# ----------------------------------------------------------
ZCTAMap <- read_sf("cb_2020_us_zcta520_500k.shp")

# ----------------------------------------------------------
# Step 8: Prepare ZIP column
# ----------------------------------------------------------
FMR_Area$ZIP <- as.character(FMR_Area$ZIP)

# ----------------------------------------------------------
# Step 9: Join FMR to ZCTA polygons
# ----------------------------------------------------------
FMR_Area_Map <- left_join(FMR_Area, ZCTAMap, by = c("ZIP" = "ZCTA5CE20"))

# ----------------------------------------------------------
# Step 10: Drop unneeded Census columns
# ----------------------------------------------------------
FMR_Area_Map <- FMR_Area_Map %>%
  select(-c(AFFGEOID20, GEOID20, NAME20, LSAD20, ALAND20, AWATER20))

# ----------------------------------------------------------
# Step 11: Convert to sf and filter valid geometry
# ----------------------------------------------------------
FMR_Area_Map <- st_as_sf(FMR_Area_Map)
if (!is.na(sf::st_crs(FMR_Area_Map))) {
  FMR_Area_Map <- st_transform(FMR_Area_Map, 4326)
}

FMR_Area_Map <- FMR_Area_Map %>%
  filter(!sf::st_is_empty(geometry) & !is.na(sf::st_geometry_type(geometry)))

# ----------------------------------------------------------
# Step 12: Fetch ACS data
# ----------------------------------------------------------
census_api_key("d18305720219d4680a63fc284f2f8c8f5bf8bc79")

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

Census_Data <- Census_Data %>%
  transmute(
    ZIP             = GEOID,
    Rentals         = DP04_0047E,
    Rentals_MOE     = DP04_0047M,
    Households      = DP04_0045E,
    Households_MOE  = DP04_0045M
  ) %>%
  filter(ZIP %in% ZIPList)

FMR_Area_Map <- FMR_Area_Map %>%
  left_join(Census_Data, by = "ZIP")

# ----------------------------------------------------------
# Step 14: Map settings
# ----------------------------------------------------------
ShadeBy        <- "BR3"
PaletteName    <- "Blues"
legend_classes <- 7

popup_labels <- c(
  ZIP               = "ZIP",
  Studio_fmt        = "Studio",
  BR1_fmt           = "1-Bed",
  BR2_fmt           = "2-Bed",
  BR3_fmt           = "3-Bed",
  BR4_fmt           = "4-Bed",
  Rentals_fmt        = "Renter-occupied units",
  Rentals_MOE_fmt    = "Renter MOE (±)",
  Households_fmt     = "Occupied housing units",
  Households_MOE_fmt = "Occupied MOE (±)"
)

friendly_names <- c(
  Studio = "Studio",
  BR1    = "1-Bed",
  BR2    = "2-Bed",
  BR3    = "3-Bed",
  BR4    = "4-Bed"
)

legend_title <- if (ShadeBy %in% names(friendly_names)) {
  friendly_names[[ShadeBy]]
} else {
  ShadeBy
}

# ----------------------------------------------------------
# Step 15: Build palette
# ----------------------------------------------------------
build_brewer_colors <- function(name, k) {
  info <- RColorBrewer::brewer.pal.info
  if (!name %in% rownames(info)) {
    stop(sprintf("Palette '%s' not found.", name))
  }
  max_n <- info[name, "maxcolors"]
  base  <- RColorBrewer::brewer.pal(min(max_n, max(3, k)), name)
  if (k <= length(base)) base[seq_len(k)] else grDevices::colorRampPalette(base)(k)
}

# ----------------------------------------------------------
# Step 16: Jenks breaks
# ----------------------------------------------------------
vals <- FMR_Area_Map[[ShadeBy]]
vals <- vals[!is.na(vals)]

ci <- classInt::classIntervals(vals, n = legend_classes, style = "jenks")
breaks <- sort(unique(ci$brks))

if (length(breaks) < 3) {
  qbreaks <- quantile(vals, probs = seq(0, 1, length.out = legend_classes + 1),
                      na.rm = TRUE, type = 7)
  qbreaks <- sort(unique(as.numeric(qbreaks)))
  if (length(qbreaks) >= 3) breaks <- qbreaks else {
    pbreaks <- pretty(range(vals, na.rm = TRUE), n = legend_classes)
    pbreaks <- sort(unique(as.numeric(pbreaks)))
    if (length(pbreaks) >= 3) breaks <- pbreaks else {
      rng <- range(vals, na.rm = TRUE)
      if (rng[1] == rng[2]) {
        eps <- if (abs(rng[1]) < 1) 1e-9 else abs(rng[1]) * 1e-9
        breaks <- c(rng[1] - eps, rng[1] + eps)
      } else breaks <- rng
    }
  }
}

breaks <- sort(unique(breaks))
if (length(breaks) < 2) {
  b0 <- vals[1]
  eps <- if (abs(b0) < 1) 1e-9 else abs(b0) * 1e-9
  breaks <- c(b0 - eps, b0 + eps)
}

n_bins <- max(1, length(breaks) - 1)
pal_colors <- build_brewer_colors(PaletteName, n_bins)

pal_bin <- colorBin(
  palette  = pal_colors,
  domain   = FMR_Area_Map[[ShadeBy]],
  bins     = breaks,
  na.color = "#cccccc",
  right    = FALSE
)

# ----------------------------------------------------------
# Step 17: Precompute FillColor + HoverLabel
# ----------------------------------------------------------
FMR_Area_Map$FillColor <- pal_bin(FMR_Area_Map[[ShadeBy]])

FMR_Area_Map$HoverLabel <- sprintf(
  "ZIP %s: %s = %s",
  FMR_Area_Map$ZIP,
  legend_title,
  ifelse(is.na(FMR_Area_Map[[ShadeBy]]), "NA",
         scales::comma(FMR_Area_Map[[ShadeBy]]))
)

# ----------------------------------------------------------
# Step 18: Popup formatting
# ----------------------------------------------------------
popup_data <- FMR_Area_Map %>%
  mutate(
    Studio_fmt = comma(Studio),
    BR1_fmt    = comma(BR1),
    BR2_fmt    = comma(BR2),
    BR3_fmt    = comma(BR3),
    BR4_fmt    = comma(BR4),
    Rentals_fmt        = comma(Rentals),
    Rentals_MOE_fmt    = comma(Rentals_MOE),
    Households_fmt     = comma(Households),
    Households_MOE_fmt = comma(Households_MOE)
  )

popup_keys <- intersect(names(popup_labels), names(popup_data))
popup_display <- popup_data %>%
  st_drop_geometry() %>%
  select(all_of(popup_keys))
colnames(popup_display) <- unname(popup_labels[popup_keys])

# ----------------------------------------------------------
# Step 19: Build Leaflet map
# ----------------------------------------------------------
Rent_Category_Map <- leaflet(FMR_Area_Map, options = leafletOptions(preferCanvas = TRUE)) %>%
  addProviderTiles(providers$CartoDB.Positron, group = "Streets (CartoDB Positron)") %>%
  addProviderTiles(providers$Esri.WorldStreetMap, group = "Streets (Esri World Street Map)") %>%
  addProviderTiles(providers$Esri.WorldImagery,   group = "Satellite (Esri World Imagery)") %>%
  addPolygons(
    fillColor   = ~ FillColor,
    color       = "#444444",
    weight      = 1,
    opacity     = 1,
    fillOpacity = 0.7,
    label = ~ HoverLabel,
    labelOptions = labelOptions(
      style = list("font-weight" = "bold"),
      textsize = "12px",
      direction = "auto"
    ),
    popup = leafpop::popupTable(
      popup_display,
      feature.id = FALSE,
      row.numbers = FALSE,
      zcol = colnames(popup_display)
    ),
    highlight = highlightOptions(
      weight = 2,
      color = "#000000",
      fillOpacity = 0.8,
      bringToFront = TRUE
    ),
    group = "FMR by ZIP"
  ) %>%
  addLegend(
    position = "bottomright",
    pal = pal_bin,
    values = FMR_Area_Map[[ShadeBy]],
    title = legend_title,
    opacity = 0.7,
    labFormat = labelFormat(big.mark = ",", digits = 0, between = " – ")
  ) %>%
  addLayersControl(
    baseGroups = c(
      "Streets (CartoDB Positron)",
      "Streets (Esri World Street Map)",
      "Satellite (Esri World Imagery)"
    ),
    options = layersControlOptions(collapsed = FALSE)
  )

Rent_Category_Map

# ----------------------------------------------------------
# Step 21: Save map
# ----------------------------------------------------------
outfile <- paste0("FMR_", ShadeBy, "_", PaletteName, "_", legend_classes, "Classes.html")
htmlwidgets::saveWidget(widget = Rent_Category_Map,
                        file = outfile,
                        selfcontained = TRUE)
message("Saved map to: ", normalizePath(outfile))

# ----------------------------------------------------------
# Step 22: Downshift map to data frame
# ----------------------------------------------------------
Data_From_Map <- st_drop_geometry(FMR_Area_Map) %>% 
  select(-c(FillColor, HoverLabel))

# ----------------------------------------------------------
# ⭐ NEW — Step 23: Add Pay + Affordability
# ----------------------------------------------------------
Hourly_Pay <- 27.50

Data_From_Map <- Data_From_Map %>%
  mutate(
    Pay = Hourly_Pay,
    Affordability = ifelse(BR3 <= 1480, "Affordable", "Unaffordable")
  )

# ----------------------------------------------------------
# ⭐ NEW — Step 24: Build Summary Table
# ----------------------------------------------------------
Summary <- Data_From_Map %>%
  group_by(Affordability) %>%
  summarise(
    Count = n(),
    Minimum = min(BR3, na.rm = TRUE),
    Average = round(mean(BR3, na.rm = TRUE)),
    Maximum = max(BR3, na.rm = TRUE),
    .groups = "drop"
  )

Summary_Table <- gt(Summary) %>%
  tab_header(title = "ZIP Code Affordability") %>%
  cols_align(align = "left")

Summary_Table

# ----------------------------------------------------------
# ⭐ NEW — Step 25: Build Full Data Table
# ----------------------------------------------------------
Data_From_Map_Table <- gt(Data_From_Map) %>%
  tab_header(title = "Data") %>%
  cols_align(align = "left")

Data_From_Map_Table