I have lived in a small town called Huntland, Tennessee, for the majority of my life, except when I lived on MTSU’s campus during my undergraduate years in college. It resides in District 3 of Franklin County, Tennessee, 34 miles North of Huntsville, Alabama. Recently, I started wondering how many people over 25 in that area and in the surrounding areas have a bachelor’s degree. Specifically, I also wanted to know how my district compared to other districts. What I found out was quite interesting, to say the least.
Franklin County borders five other counties in Tennessee: Lincoln, Moore, Coffee, Grundy, and Marion. In terms of the percentage of people over 25 who have a bachelor’s degree, Moore County has the highest, at 24.1 percent, while Grundy County has the lowest, at 14.3 percent. Franklin County has the second-highest percentage, at 23.9 percent, followed by Coffee, Lincoln, and Marion. The data initially surprised me with how high Moore and Franklin counties’ percentages are; I expected none of these counties to eclipse 20 percent. However, looking at the map, I realized there are several factors at play that could affect these percentages. For instance, proximity to a higher education institution can affect how people travel and either incentivize or dissuade them from attending. Median household income could also dictate whether people in these areas could even afford to go to certain colleges, like Sewanee. If I were looking at data regarding percentages of people with associate’s degrees, I would likely see an increase due to the locations of Motlow and TCAT in these areas. It could be possible that people who live in these areas, after earning an associate’s degree, would try to seek further education at nearby universities.
When looking at the district data, the four highest districts eclipsed 40 percent. District 5 in Franklin County had the highest at 56.4 percent, followed by District 3 in Moore County at 46 percent, and Districts 16 and 15 in Coffee County at 42.4 and 42 percent, respectively. The three lowest districts were below 10 percent. District 10 in Coffee County had the lowest at 8.3 percent, followed by District 2 in Moore County at 9.7 percent, and District 7 in Coffee County at 9.9 percent. The district I live in, District 3 in Franklin County, fell around the middle range at 18.3 percent. I noticed that a majority of the counties, except for Grundy, had some variation in their percentages. They also had a pattern that I initially predicted I would see: the higher-percentage districts typically have at least one institution or university either in or near that district. I most likely would not have noticed that with certain districts if I just had the county map. For example, some districts in Marion County have a relatively high percentage due to being in proximity to Sewanee. People who have a high enough income are more likely to go to colleges that they can both afford and easily get to.
Before this analysis, I expected to find a lower percentage of people over 25 with a bachelor’s degree than what was presented. Again, I did not expect any of these counties to surpass 20 percent. I was pleasantly surprised to see that four of them surpassed my expectations. I expected to see higher percentages in districts that have universities nearby; however, I did not expect them to be at the percentages they were, especially the top five highest percentages. The subdivision map gave more geographical context to different areas in each county. It consistently showed the pattern between high-percentage areas and their proximity to universities. If I were working for some of these universities and institutions, like a social media expert or even in advertising, I would definitely target local areas and capitalize on their local audience. People would want the easiest path toward further education, and part of that is how close a university is to their home. If I were to choose between going out of state, traveling a ways away, or staying near my home to further my education, nine times out of ten I would stay home.
Below is the code I used to conduct the report.
############################################################
# CODE FOR COUNTY LEVEL
############################################################
############################################################
# 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 <- "DP02_0068P"
# 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: Optional Filtering
############################################################
# Uncomment and edit the code below if you want to keep only
# selected areas.
#
# To uncomment:
# 1. Select the lines with your mouse.
# 2. Press Ctrl+Shift+C (Windows) or Cmd+Shift+C (Mac).
mydata <- mydata |>
filter(
Area %in% c(
"Franklin County, Tennessee",
"Lincoln County, Tennessee",
"Moore County, Tennessee",
"Coffee County, Tennessee",
"Grundy County, Tennessee",
"Marion County, Tennessee"
)
)
Countydata <- mydata
Countydata
############################################################
# 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/>",
"Estimate: ",
format(mydata$Estimate, big.mark = ","),
"<br/>",
"Plus/Minus: ",
format(mydata$Margin_of_Error, big.mark = ",")
)
############################################################
# STEP 10: Build Color Palette
############################################################
qs <- unique(
quantile(
mydata$Estimate,
probs = seq(0, 1, length.out = 6),
na.rm = TRUE
)
)
pal <- colorBin(
palette = "Blues",
domain = mydata$Estimate,
bins = qs,
pretty = FALSE
)
############################################################
# STEP 11: Create Choropleth Map
############################################################
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 = "Estimate",
labFormat = labelFormat(
big.mark = ","
)
)
CountyMap <- AreaMap
CountyMap
############################################################
# 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,
"
Estimate: ",
format(Estimate, big.mark = ","),
"
Plus/Minus: ",
format(Margin_of_Error, big.mark = ",")
)
)
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(
"ACS Estimates by Area",
"
Error bars show ACS margins of error."
)
),
xaxis = list(
title = "Estimate",
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
)
############################################################
# CODE FOR COUNTY SUBDIVISIONS
############################################################
############################################################
# 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 <- "DP02_0068P"
# 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 subdivision",
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: Optional Filtering
############################################################
# OPTION A: Filter for specific counties.
#
# Uncomment to keep only county subdivisions whose
# names contain the specified county names. To search
# for just a single county, use just the county name
# without the | character.
mydata <- mydata |>
filter(
str_detect(
Area,
"Franklin|Lincoln|Moore|Coffee|Grundy|Marion"
)
)
SubCountydata <- mydata
SubCountydata
############################################################
# 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
)
SublevelTable <- ResultsTable
SublevelTable
############################################################
# STEP 9: Create Pop-Up Content
############################################################
mydata$popup <- paste0(
"", mydata$Area, "
",
"Estimate: ",
format(mydata$Estimate, big.mark = ","),
"
",
"Plus/Minus: ",
format(mydata$Margin_of_Error, big.mark = ",")
)
############################################################
# STEP 10: Build Color Palette
############################################################
qs <- unique(
quantile(
mydata$Estimate,
probs = seq(0, 1, length.out = 6),
na.rm = TRUE
)
)
pal <- colorBin(
palette = "Blues",
domain = mydata$Estimate,
bins = qs,
pretty = FALSE
)
############################################################
# STEP 11: Create Choropleth Map
############################################################
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 = "Estimate",
labFormat = labelFormat(
big.mark = ","
)
)
SubCountyMap <- AreaMap
SubCountyMap
############################################################
# 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,
"
Estimate: ",
format(Estimate, big.mark = ","),
"
Plus/Minus: ",
format(Margin_of_Error, big.mark = ",")
)
)
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(
"ACS Estimates by State",
"
Error bars show ACS margins of error."
)
),
xaxis = list(
title = "Estimate",
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
)
)
SublevelPlot <- DotPlot
SublevelPlot
############################################################
# STEP 13: Export Dot Plot (Optional)
############################################################
saveWidget(
widget = as_widget(SublevelPlot),
file = "ACSGraph.html",
selfcontained = TRUE
)
############################################################
# STEP 14: Export Map (Optional)
############################################################
saveWidget(
widget = AreaMap,
file = "ACSMap.html",
selfcontained = TRUE
)