This report looks at the average commute time within Davidson County, Tennessee, using data from the 2024 American Community Survey (ACS) five-year estimates. The variable I chose was DP03_0025, which measures the average travel time to work in minutes. I wanted to compare Davidson County’s average commute time with its six neighboring counties, especially since Nashville is known for its heavy traffic.
Looking at the county-level map, Davidson County appears to have one of the shorter average commute times compared to its neighboring counties. Robertson and Cheatham counties have some of the longer commute times, while Williamson and Rutherford counties appear to have shorter commute times than several of the other surrounding counties.
I found this interesting because I initially expected Davidson County to have longer commute times, given how congested Nashville can get, especially during rush hour. However, the map suggests that even though Nashville experiences heavy traffic, people living within Davidson County may have shorter distances to travel to work compared to those commuting from surrounding counties. This challenged my initial expectations and made me curious about how commute times might differ within Davidson County itself.dson County. Since Nashville is known for its heavy traffic, I was interested in seeing whether the data reflected what I’ve personally experienced driving around the area.
Looking at the census-tract map, I noticed that average commute times varied quite a bit within Davidson County. While the county-level map showed Davidson County as having one of the shorter commute times compared to its neighboring counties, the census-tract map revealed that this wasn’t necessarily the case for everyone living within the county.
Based on the map, the highest average commute times appeared in some of the northern, southeastern, and southwestern parts of Davidson County, with estimates reaching approximately 41.9 minutes. Meanwhile, the lowest commute times appeared closer to downtown Nashville and the central parts of the county, with estimates as low as 12.2 minutes.
I found this interesting because the areas closer to downtown Nashville generally appeared to have shorter commute times, while areas farther away tended to have longer commutes. One possible explanation is that many employment opportunities are concentrated around downtown Nashville and its surrounding areas. Residents living farther from these employment centers may have to travel longer distances to work. However, factors such as housing affordability, access to public transportation, and where people work could also contribute to these differences.
Overall, the census-tract map helped me see how much variation can exist within a single county, even when its overall average commute time appears relatively low.
Before beginning this analysis, I expected Davidson County to have some of the longest average commute times because of how much traffic Nashville experiences, especially during rush hour. However, the results challenged my expectations because Davidson County appeared to have shorter commute times compared to several of its neighboring counties.
What stood out to me the most was how much more information became visible when looking at the census-tract map. While the county-level map gave me a general idea of how Davidson County compared to surrounding counties, it didn’t show the differences in commute times between areas within Davidson County. The census-tract map helped me understand that even though a county may have a relatively short average commute time, that doesn’t necessarily reflect everyone’s experience.
If I were a journalist, I would be interested in exploring how Nashville’s growing population and housing costs might affect where people choose to live and how far they travel for work. I would want to look into whether people are moving farther away from major employment areas because of housing affordability and whether that contributes to longer commutes. I think this could be an interesting local story because it connects transportation, housing, and the everyday experiences of people living and working in the Nashville area.
# MAP 1: Davidson County and Neighboring Counties
############################################################
# STEP 1: Load Packages
############################################################
if (!require("tidycensus")) install.packages("tidycensus")
if (!require("tidyverse")) install.packages("tidyverse")
if (!require("kableExtra")) install.packages("kableExtra")
if (!require("sf")) install.packages("sf")
if (!require("leaflet")) install.packages("leaflet")
if (!require("htmlwidgets")) install.packages("htmlwidgets")
if (!require("plotly")) install.packages("plotly")
library(tidycensus)
library(tidyverse)
library(kableExtra)
library(sf)
library(leaflet)
library(htmlwidgets)
library(plotly)
############################################################
# STEP 2: Verify Census API Key
############################################################
if (!nzchar(Sys.getenv("CENSUS_API_KEY"))) {
stop(
paste(
"\nNo Census API key was found.",
"\n\nTo obtain a free Census API key, visit:",
"\nhttps://api.census.gov/data/key_signup.html",
"\n\nThen run the one-time setup code at the",
"\ntop of this script to store your key.",
"\n"
)
)
}
############################################################
# STEP 3: Explore 2024 Codebooks and Choose an ACS Variable
############################################################
ProfileTables <- load_variables(2024, "acs5/profile")
# DetailedTables <- load_variables(2024, "acs5")
# SubjectTables <- load_variables(2024, "acs5/subject")
# Replace the variable code below with the ACS variable
# you want to download.
my_variable <- "DP03_0025"
# Example variables:
#
# DP05_0001 = Total population
# DP03_0062 = Median Household Income
# DP03_0128P = Poverty Rate
# DP02_0068P = Bachelor's Degree or Higher Rate
# DP05_0018 = Median Age
# DP04_0046P = Homeownership Rate
# DP04_0134 = Median Gross Rent
# DP04_0142P = Pct. renters paying 35%+ HH income in rent (GRAPI)
# DP05_0090P = Hispanic or Latino Population Percentage
# DP02_0094P = Foreign-Born Percentage
# DP03_0009P = Unemployment Rate
# DP03_0025 = Average Commute Time
############################################################
# STEP 4: Download ACS Data
############################################################
# Common ACS geography options:
#
# "state"
# "county"
# "county subdivision"
# "tract"
# "block group"
# "zcta"
#
# Most of this script works for any ACS geography.
# Some geographies may require additional filtering
# or display adjustments.
mydata <- get_acs(
geography = "county",
state = "TN",
year = 2024,
survey = "acs5",
variables = my_variable,
geometry = TRUE
)
############################################################
# STEP 5: Keep Needed Variables and Geometry
############################################################
mydata <- mydata |>
select(
Area = NAME,
Variable = variable,
Estimate = estimate,
Margin_of_Error = moe,
geometry
)
############################################################
# STEP 5B: Transform Coordinates for Leaflet
############################################################
mydata <- st_transform(
mydata,
crs = 4326
)
############################################################
# STEP 6: Filter Davidson County and Neighboring Counties
############################################################
mydata <- mydata |>
filter(
Area %in% c(
"Davidson County, Tennessee",
"Cheatham County, Tennessee",
"Robertson County, Tennessee",
"Sumner County, Tennessee",
"Wilson County, Tennessee",
"Rutherford County, Tennessee",
"Williamson County, Tennessee"
)
)
############################################################
# STEP 7: Sort Results from Highest to Lowest
############################################################
mydata <- mydata |>
arrange(desc(Estimate))
############################################################
# STEP 8: Display Results as a Table
############################################################
ResultsTable <- mydata |>
st_drop_geometry() |>
kbl(
col.names = c(
"Area",
"Variable",
"Estimate",
"Margin of Error"
),
format.args = list(big.mark = ",")
) |>
kable_styling(
bootstrap_options = c("striped", "hover"),
full_width = FALSE
)
ResultsTable
############################################################
# STEP 9: Create Pop-Up Content
############################################################
mydata$popup <- paste0(
"<strong>", mydata$Area, "</strong><br/>",
"Average Commute Time: ",
format(mydata$Estimate, big.mark = ","),
" minutes",
"<br/>",
"Plus/Minus: ",
format(mydata$Margin_of_Error, big.mark = ","),
" minutes"
)
############################################################
# STEP 10: Build Color Palette
############################################################
qs <- unique(
quantile(
mydata$Estimate,
probs = seq(0, 1, length.out = 6),
na.rm = TRUE
)
)
pal <- colorBin(
palette = "Reds",
domain = mydata$Estimate,
bins = qs,
pretty = FALSE
)
############################################################
# STEP 11: Create Choropleth Map
############################################################
CountyMap <-AreaMap <- leaflet(mydata) |>
addProviderTiles(
providers$Esri.WorldTopoMap
) |>
addPolygons(
fillColor = ~pal(Estimate),
fillOpacity = 0.5,
color = "black",
weight = 1,
popup = ~popup
) |>
addLegend(
pal = pal,
values = ~Estimate,
title = "Commute Time (minutes)",
labFormat = labelFormat(
big.mark = ","
)
)
AreaMap
############################################################
# STEP 12: Create Plotly Dot Plot
############################################################
plotdf <- mydata |>
st_drop_geometry() |>
mutate(
point_color = pal(Estimate),
y_ordered = reorder(
Area,
Estimate
),
hover_text = paste0(
Area,
"<br>Average Commute Time: ",
format(Estimate, big.mark = ","),
" minutes",
"<br>Plus/Minus: ",
format(Margin_of_Error, big.mark = ","),
" minutes"
)
)
DotPlot <- plot_ly(
data = plotdf,
x = ~Estimate,
y = ~as.character(y_ordered),
type = "scatter",
mode = "markers",
showlegend = FALSE,
marker = list(
color = ~point_color,
size = 8,
line = list(
color = "rgba(120,120,120,0.9)",
width = 0.5
)
),
error_x = list(
type = "data",
array = ~Margin_of_Error,
arrayminus = ~Margin_of_Error,
color = "rgba(0,0,0,0.65)",
thickness = 1
),
text = ~hover_text,
hovertemplate = "%{text}"
) |>
layout(
title = list(
text = paste0(
"Average Commute Times by County",
"
Error bars show ACS margins of error."
)
),
xaxis = list(
title = "Average Commute Time (minutes)",
tickformat = ",.0f",
automargin = TRUE
),
yaxis = list(
title = "",
automargin = TRUE,
categoryorder = "array",
categoryarray = levels(plotdf$y_ordered)
),
margin = list(
l = 200,
r = 20,
b = 60,
t = 60,
pad = 2
)
)
DotPlot
############################################################
# STEP 13: Export Dot Plot (Optional)
############################################################
saveWidget(
widget = as_widget(DotPlot),
file = "ACSGraph.html",
selfcontained = TRUE
)
############################################################
# STEP 14: Export Map (Optional)
############################################################
saveWidget(
widget = AreaMap,
file = "ACSMap.html",
selfcontained = TRUE
)
CountyMap
# Map 2: Davidson County Census Tracts
############################################################
# STEP 1: Load Packages
############################################################
if (!require("tidycensus")) install.packages("tidycensus")
if (!require("tidyverse")) install.packages("tidyverse")
if (!require("kableExtra")) install.packages("kableExtra")
if (!require("sf")) install.packages("sf")
if (!require("leaflet")) install.packages("leaflet")
if (!require("htmlwidgets")) install.packages("htmlwidgets")
if (!require("plotly")) install.packages("plotly")
library(tidycensus)
library(tidyverse)
library(kableExtra)
library(sf)
library(leaflet)
library(htmlwidgets)
library(plotly)
############################################################
# STEP 2: Verify Census API Key
############################################################
if (!nzchar(Sys.getenv("CENSUS_API_KEY"))) {
stop(
paste(
"\nNo Census API key was found.",
"\n\nTo obtain a free Census API key, visit:",
"\nhttps://api.census.gov/data/key_signup.html",
"\n\nThen run the one-time setup code at the",
"\ntop of this script to store your key.",
"\n"
)
)
}
############################################################
# STEP 3: Explore 2024 Codebooks and Choose an ACS Variable
############################################################
ProfileTables <- load_variables(2024, "acs5/profile")
# DetailedTables <- load_variables(2024, "acs5")
# SubjectTables <- load_variables(2024, "acs5/subject")
# Replace the variable code below with the ACS variable
# you want to download.
my_variable <- "DP03_0025"
# Example variables:
#
# DP05_0001 = Total population
# DP03_0062 = Median Household Income
# DP03_0128P = Poverty Rate
# DP02_0068P = Bachelor's Degree or Higher Rate
# DP05_0018 = Median Age
# DP04_0046P = Homeownership Rate
# DP04_0134 = Median Gross Rent
# DP04_0142P = Pct. renters paying 35%+ HH income in rent (GRAPI)
# DP05_0090P = Hispanic or Latino Population Percentage
# DP02_0094P = Foreign-Born Percentage
# DP03_0009P = Unemployment Rate
# DP03_0025 = Average Commute Time
############################################################
# STEP 4: Download ACS Data
############################################################
mydata <- get_acs(
geography = "tract",
state = "TN",
year = 2024,
survey = "acs5",
variables = my_variable,
geometry = TRUE
)
############################################################
# STEP 5: Keep Needed Variables and Geometry
############################################################
mydata <- mydata |>
select(
Area = NAME,
Variable = variable,
Estimate = estimate,
Margin_of_Error = moe,
geometry
)
############################################################
# STEP 5B: Transform Coordinates for Leaflet
############################################################
mydata <- st_transform(
mydata,
crs = 4326
)
############################################################
# STEP 6: Filter Davidson County Census Tracts
############################################################
mydata <- mydata |>
filter(
str_detect(Area, "Davidson")
)
############################################################
# STEP 7: Sort Results from Highest to Lowest
############################################################
mydata <- mydata |>
arrange(desc(Estimate))
############################################################
# STEP 8: Display Results as a Table
############################################################
ResultsTable <- mydata |>
st_drop_geometry() |>
kbl(
col.names = c(
"Area",
"Variable",
"Estimate",
"Margin of Error"
),
format.args = list(big.mark = ",")
) |>
kable_styling(
bootstrap_options = c("striped", "hover"),
full_width = FALSE
)
ResultsTable
############################################################
# STEP 9: Create Pop-Up Content
############################################################
mydata$popup <- paste0(
"<strong>", mydata$Area, "</strong><br/>",
"Average Commute Time: ",
format(mydata$Estimate, big.mark = ","),
" minutes",
"<br/>",
"Plus/Minus: ",
format(mydata$Margin_of_Error, big.mark = ","),
" minutes"
)
############################################################
# STEP 10: Build Color Palette
############################################################
qs <- unique(
quantile(
mydata$Estimate,
probs = seq(0, 1, length.out = 6),
na.rm = TRUE
)
)
pal <- colorBin(
palette = "Reds",
domain = mydata$Estimate,
bins = qs,
pretty = FALSE
)
############################################################
# STEP 11: Create Choropleth Map
############################################################
TractMap <- AreaMap <- leaflet(mydata) |>
addProviderTiles(
providers$Esri.WorldTopoMap
) |>
addPolygons(
fillColor = ~pal(Estimate),
fillOpacity = 0.5,
color = "black",
weight = 1,
popup = ~popup
) |>
addLegend(
pal = pal,
values = ~Estimate,
title = "Commute Time by Census Tract",
labFormat = labelFormat(
big.mark = ","
)
)
AreaMap
############################################################
# STEP 12: Create Plotly Dot Plot
############################################################
plotdf <- mydata |>
st_drop_geometry() |>
mutate(
point_color = pal(Estimate),
y_ordered = reorder(
Area,
Estimate
),
hover_text = paste0(
Area,
"<br>Average Commute Time: ",
format(Estimate, big.mark = ","),
" minutes",
"<br>Plus/Minus: ",
format(Margin_of_Error, big.mark = ","),
" minutes"
)
)
DotPlot <- plot_ly(
data = plotdf,
x = ~Estimate,
y = ~as.character(y_ordered),
type = "scatter",
mode = "markers",
showlegend = FALSE,
marker = list(
color = ~point_color,
size = 8,
line = list(
color = "rgba(120,120,120,0.9)",
width = 0.5
)
),
error_x = list(
type = "data",
array = ~Margin_of_Error,
arrayminus = ~Margin_of_Error,
color = "rgba(0,0,0,0.65)",
thickness = 1
),
text = ~hover_text,
hovertemplate = "%{text}"
) |>
layout(
title = list(
text = paste0(
"Average Commute Times by County",
"
Error bars show ACS margins of error."
)
),
xaxis = list(
title = "Average Commute Time (minutes)",
tickformat = ",.0f",
automargin = TRUE
),
yaxis = list(
title = "",
automargin = TRUE,
categoryorder = "array",
categoryarray = levels(plotdf$y_ordered)
),
margin = list(
l = 200,
r = 20,
b = 60,
t = 60,
pad = 2
)
)
DotPlot
############################################################
# STEP 13: Export Dot Plot (Optional)
############################################################
saveWidget(
widget = as_widget(DotPlot),
file = "ACSGraph.html",
selfcontained = TRUE
)
############################################################
# STEP 14: Export Map (Optional)
############################################################
saveWidget(
widget = AreaMap,
file = "DavidsonTractMap.html",
selfcontained = TRUE
)
TractMap