Tennessee’s 2023 and 2026 U.S. House districts, by geographic
density. The analysis quantified compactness by calculating each
district’s Polsby-Popper score, which is the ratio of the
district’s area to the area of a circle with a circumference that
matches the district’s perimeter. Each score ranges from zero to 1, with
1 being optimally compact.
Code:
# ============================================================
# Step 0. INSTALL AND LOAD REQUIRED PACKAGES
# ============================================================
if (!require("tidyverse")) install.packages("tidyverse")
if (!require("tidycensus")) install.packages("tidycensus")
if (!require("sf")) install.packages("sf")
if (!require("leaflet")) install.packages("leaflet")
if (!require("leaflet.extras2")) install.packages("leaflet.extras2")
if (!require("kableExtra")) install.packages("kableExtra")
if (!require("htmlwidgets")) install.packages("htmlwidgets")
library(tidyverse)
library(tidycensus)
library(sf)
library(leaflet)
library(leaflet.extras2)
library(kableExtra)
library(htmlwidgets)
# ============================================================
# Step 1. LOAD & STANDARDIZE DISTRICT GEOMETRY
# ============================================================
# --- 2023 Enacted Districts ---
cd_2023 <- get_acs(
geography = "congressional district",
state = "TN",
variables = "B01001_001", # dummy variable
year = 2023,
survey = "acs5",
geometry = TRUE
) %>%
st_transform(4326) %>%
mutate(
district_num = as.integer(stringr::str_extract(NAME, "\\d+")),
cd_name = paste0("District ", district_num),
label = as.character(district_num)
) %>%
select(cd_name, label, district_num, geometry)
# --- 2026 Proposed Districts ---
NewDistricts <- st_read(
"NewCongressional26.shp",
quiet = TRUE
) %>%
st_transform(4326) %>%
st_make_valid() %>%
mutate(
district_num = as.integer(DISTRICT),
cd_name = paste0("District ", district_num),
label = as.character(district_num)
) %>%
select(cd_name, label, district_num, geometry)
# ============================================================
# Step 2. POLSBY–POPPER COMPACTNESS FUNCTION (CORRECT)
# ============================================================
# Uses polygon boundaries for perimeter, equal-area CRS
compute_polsby_popper <- function(districts_sf) {
districts_sf %>%
st_transform(5070) %>% # CONUS Albers (equal-area)
mutate(
area_m2 = as.numeric(st_area(geometry)),
perimeter_m = as.numeric(st_length(st_boundary(geometry))),
compactness = if_else(
is.finite(perimeter_m) & perimeter_m > 0,
(4 * pi * area_m2) / (perimeter_m^2),
NA_real_
)
) %>%
st_transform(4326)
}
cd_2023_compact <- compute_polsby_popper(cd_2023)
cd_2026_compact <- compute_polsby_popper(NewDistricts)
# ============================================================
# Step 3. COLOR PALETTE (FINITE VALUES ONLY)
# ============================================================
all_compactness <- c(
cd_2023_compact$compactness,
cd_2026_compact$compactness
)
all_compactness <- all_compactness[is.finite(all_compactness)]
pal <- colorNumeric(
palette = "viridis",
domain = range(all_compactness),
na.color = "transparent"
)
popup_text <- ~paste0(
"<b>District ", label, "</b><br><br>",
"<b>Polsby–Popper:</b> ",
round(compactness, 3)
)
# ============================================================
# Step 4. LABEL POINTS
# ============================================================
cd_2023_labels <- cd_2023_compact %>% st_point_on_surface()
cd_2026_labels <- cd_2026_compact %>% st_point_on_surface()
# ============================================================
# Step 5. MAP 1: 2023 ENACTED DISTRICTS
# ============================================================
Map_2023 <- leaflet(cd_2023_compact) %>%
addProviderTiles("CartoDB.Positron", group = "Positron (Light)") %>%
addProviderTiles("Esri.WorldStreetMap", group = "Street Map") %>%
addProviderTiles("Esri.WorldImagery", group = "Satellite") %>%
addPolygons(
fillColor = ~pal(compactness),
fillOpacity = 0.75,
color = "#333333",
weight = 1.5,
popup = popup_text,
group = "Congressional Districts"
) %>%
addLabelOnlyMarkers(
data = cd_2023_labels,
label = ~label,
labelOptions = labelOptions(
noHide = TRUE,
direction = "center",
textsize = "12px",
style = list("font-weight" = "bold")
),
group = "District Labels"
) %>%
addLegend(
pal = pal,
values = ~compactness,
title = "Polsby–Popper<br>Compactness",
position = "topright"
) %>%
addLayersControl(
baseGroups = c("Positron (Light)", "Street Map", "Satellite"),
overlayGroups = c("Congressional Districts", "District Labels"),
options = layersControlOptions(position = "bottomleft", collapsed = TRUE)
)
Map_2023
# ============================================================
# Step 6. TABLE 1: 2023 COMPACTNESS (SORTED BY DISTRICT)
# ============================================================
Table_2023 <- cd_2023_compact %>%
st_drop_geometry() %>%
arrange(district_num) %>%
mutate(
Compactness = round(compactness, 3)
) %>%
select(
District = cd_name,
Compactness
) %>%
kbl(
format = "html",
caption = "Geographic Compactness (Polsby–Popper), 2023"
) %>%
kable_styling(
full_width = FALSE,
bootstrap_options = c("striped", "hover", "condensed")
)
Table_2023
# ============================================================
# Step 7. MAP 2: 2026 PROPOSED DISTRICTS
# ============================================================
Map_2026 <- leaflet(cd_2026_compact) %>%
addProviderTiles("CartoDB.Positron", group = "Positron (Light)") %>%
addProviderTiles("Esri.WorldStreetMap", group = "Street Map") %>%
addProviderTiles("Esri.WorldImagery", group = "Satellite") %>%
addPolygons(
fillColor = ~pal(compactness),
fillOpacity = 0.75,
color = "#333333",
weight = 1.5,
popup = popup_text,
group = "Congressional Districts"
) %>%
addLabelOnlyMarkers(
data = cd_2026_labels,
label = ~label,
labelOptions = labelOptions(
noHide = TRUE,
direction = "center",
textsize = "12px",
style = list("font-weight" = "bold")
),
group = "District Labels"
) %>%
addLegend(
pal = pal,
values = ~compactness,
title = "Polsby–Popper<br>Compactness",
position = "topright"
) %>%
addLayersControl(
baseGroups = c("Positron (Light)", "Street Map", "Satellite"),
overlayGroups = c("Congressional Districts", "District Labels"),
options = layersControlOptions(position = "bottomleft", collapsed = TRUE)
)
Map_2026
# ============================================================
# Step 8. TABLE 2: 2026 COMPACTNESS (SORTED BY DISTRICT)
# ============================================================
Table_2026 <- cd_2026_compact %>%
st_drop_geometry() %>%
arrange(district_num) %>%
mutate(
Compactness = round(compactness, 3)
) %>%
select(
District = cd_name,
Compactness
) %>%
kbl(
format = "html",
caption = "Geographic Compactness (Polsby–Popper), 2026"
) %>%
kable_styling(
full_width = FALSE,
bootstrap_options = c("striped", "hover", "condensed")
)
Table_2026
# ============================================================
# Step 9. EXPORT MAPS AND TABLES
# ============================================================
saveWidget(Map_2023, "Compactness_2023_Map.html", selfcontained = TRUE)
saveWidget(Map_2026, "Compactness_2026_Map.html", selfcontained = TRUE)
save_kable(Table_2023, "Compactness_2023_Table.html")
save_kable(Table_2026, "Compactness_2026_Table.html")