This map and table show where the most people in Davidson County ages 19-64 are employed and do not have health insurance. The map shows my shading areas to visualize estimates and the table shows the data by district in descending order. The graph also shows the percentage with a visual margin of error.
| Area | Estimate |
|---|---|
| District 28 | 30.4 |
| District 9 | 28.3 |
| District 30 | 28.0 |
| District 16 | 27.1 |
| District 27 | 23.6 |
| District 8 | 22.8 |
| District 26 | 21.8 |
| District 29 | 20.6 |
| District 2 | 19.5 |
| District 13 | 19.0 |
| District 15 | 18.9 |
| District 33 | 16.1 |
| District 10 | 14.1 |
| District 31 | 13.7 |
| District 32 | 12.5 |
| District 12 | 12.4 |
| District 21 | 11.9 |
| District 11 | 11.2 |
| District 7 | 10.7 |
| District 14 | 10.7 |
| District 20 | 10.2 |
| District 5 | 10.1 |
| District 3 | 9.8 |
| District 1 | 9.6 |
| District 4 | 9.4 |
| District 19 | 8.4 |
| District 17 | 8.0 |
| District 22 | 7.7 |
| District 6 | 7.6 |
| District 18 | 6.9 |
| District 35 | 5.3 |
| District 25 | 4.3 |
| District 23 | 4.2 |
| District 24 | 3.6 |
| District 34 | 1.3 |
# ----------------------------------------------------------
# Step 1: Install required packages (if missing)
# ----------------------------------------------------------
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("htmlwidgets"))
install.packages("htmlwidgets")
if (!require("plotly"))
install.packages("plotly") # For the interactive dot plot
# ----------------------------------------------------------
# Step 2: Load libraries
# ----------------------------------------------------------
library(tidyverse)
library(tidycensus)
library(sf)
library(leaflet)
library(htmlwidgets)
library(plotly)
# ----------------------------------------------------------
# Step 3: Transmit Census API key (uncomment and paste yours)
# ----------------------------------------------------------
#census_api_key("5bb969fad7e39e89d2b686059660978d67b548b9")
# ----------------------------------------------------------
# Step 4: Fetch ACS codebooks (for variable lookup if needed)
# ----------------------------------------------------------
DetailedTables <- load_variables(2024, "acs5", cache = TRUE)
SubjectTables <- load_variables(2024, "acs5/subject", cache = TRUE)
ProfileTables <- load_variables(2024, "acs5/profile", cache = TRUE)
# ----------------------------------------------------------
# Step 5: Specify target variable(s)
# ----------------------------------------------------------
VariableList <- c(Estimate_ = "DP03_0108P")
# ----------------------------------------------------------
# Step 6: Fetch ACS data (county subdivision, Tennessee)
# ----------------------------------------------------------
mydata <- get_acs(
geography = "county subdivision",
state = "TN",
variables = VariableList,
year = 2024,
survey = "acs5",
output = "wide",
geometry = TRUE
)
# ----------------------------------------------------------
# Step 7: Reformat the NAME field into Area / County / State
# ----------------------------------------------------------
mydata <- separate_wider_delim(
mydata,
NAME,
delim = ", ",
names = c("Area", "County", "State")
)
# ----------------------------------------------------------
# Step 8: Filter to Rutherford County
# ----------------------------------------------------------
filtereddata <- mydata %>%
filter(County %in% c("Davidson County"))
# ----------------------------------------------------------
# Step 9: Prepare data for mapping (rename, as sf, CRS)
# ----------------------------------------------------------
mapdata <- filtereddata %>%
rename(
Estimate = Estimate_E,
Range = Estimate_M
) %>%
st_as_sf()
# Ensure CRS is WGS84 for Leaflet
mapdata <- st_transform(mapdata, 4326)
# ----------------------------------------------------------
# Step 10: Build color palette with quantile-based breaks
# ----------------------------------------------------------
qs <- quantile(mapdata$Estimate, probs = seq(0, 1, length.out = 6), na.rm = TRUE)
pal <- colorBin(
palette = "Greens", # Can specify other palettes here
domain = mapdata$Estimate,
bins = qs,
pretty = FALSE
)
# ----------------------------------------------------------
# Step 11: Build the plotly dot plot with error bars
# ----------------------------------------------------------
# Add point color from the same Leaflet palette and ordered y factor
filtereddata <- filtereddata %>%
mutate(
point_color = pal(Estimate_E),
y_ordered = reorder(Area, Estimate_E),
hover_text = dplyr::if_else(
!is.na(Area),
paste0("Area: ", Area),
Area
)
)
# Create the plotly scatter with horizontal error bars and thin gray borders
mygraph <- plot_ly(
data = filtereddata,
x = ~Estimate_E,
y = ~y_ordered,
type = "scatter",
mode = "markers",
marker = list(
color = ~point_color,
size = 8,
line = list(
color = "rgba(120,120,120,0.9)", # thin gray border for contrast
width = 0.5
)
),
error_x = list(
type = "data",
array = ~Estimate_M, # + side
arrayminus = ~Estimate_M, # - side
color = "rgba(0,0,0,0.65)",
thickness = 1
),
text = ~hover_text,
# Show District (from hover_text) and the X value with thousands separators
hovertemplate = "%{text}<br>%{x:,}<extra></extra>"
) %>%
layout(
title = list(text = "Estimates by area<br><sup>County subdivisions. Brackets show error margins.</sup>"),
xaxis = list(title = "ACS estimate"),
yaxis = list(title = "")
)
# display the plot
mygraph
# ----------------------------------------------------------
# Step 12: Create popup content for the map
# ----------------------------------------------------------
mapdata$popup <- paste0(
"<strong>", mapdata$Area, "</strong><br/>",
"<hr>",
"Estimate: ", format(mapdata$Estimate, big.mark = ","), "<br/>",
"Plus/Minus: ", format(mapdata$Range, big.mark = ",")
)
# ----------------------------------------------------------
# Step 13: Build the Leaflet map
# ----------------------------------------------------------
DivisionMap <- leaflet(mapdata) %>%
# Choose one basemap:
addProviderTiles(providers$CartoDB.Positron) %>%
# addProviderTiles(providers$Esri.WorldStreetMap, group = "Streets (Esri World Street Map)") %>%
# addProviderTiles(providers$Esri.WorldImagery, group = "Satellite (Esri World Imagery)") %>%
addPolygons(
fillColor = ~pal(Estimate),
fillOpacity = 0.5,
color = "black",
weight = 1,
popup = ~popup
) %>%
addLegend(
pal = pal,
values = ~Estimate,
title = "Estimate",
labFormat = labelFormat(big.mark = ",")
)
DivisionMap
# ----------------------------------------------------------
# Step 14: Export graph as a standalone HTML file
# ----------------------------------------------------------
# This creates a fully self-contained HTML file for the dot plot.
saveWidget(
widget = as_widget(mygraph),
file = "ACSGraph.html",
selfcontained = TRUE
)
# ----------------------------------------------------------
# Step 15: Export map as a standalone HTML file
# ----------------------------------------------------------
# This creates a fully self-contained HTML you can open or share.
# Adjust the path/filename as you like.
saveWidget(
widget = DivisionMap,
file = "ACSMap.html",
selfcontained = TRUE
)
# ----------------------------------------------------------
# Step X: Create formatted table (District style)
# ----------------------------------------------------------
if (!require("gt")) install.packages("gt")
library(gt)
table_output <- filtereddata %>%
transmute(
Area = paste("District", str_extract(Area, "\\d+")), # Extract district number
Estimate = round(Estimate_E, 1)
) %>%
arrange(desc(Estimate)) %>%
gt() %>%
cols_label(
Area = "Area",
Estimate = "Estimate"
) %>%
cols_align(
align = "left",
columns = Area
) %>%
cols_align(
align = "right",
columns = Estimate
) %>%
tab_options(
table.border.top.width = px(2),
table.border.bottom.width = px(2),
column_labels.border.bottom.width = px(2),
table.font.size = 16
)
# View table
table_output