Report 7

County-Level Analysis

I chose Knox County, Tennessee, for this assignment because that’s my hometown. I wanted to examine the median age of residents in Knox County and the eight surrounding counties, using data from the 2024 American Community Survey (ACS). I was interested in seeing how the ages compared and whether there were any noticeable differences between the counties.

Looking at the county-level map, Knox County had the lowest median age at approximately 37 years old. Loudon County had the highest at nearly 49 years old. I figured Knox County would have a younger population because of the University of Tennessee. However, I was surprised by how much younger it was compared to some neighboring counties. I also didn’t realize how much the median age varied across East Tennessee.

Within-County Analysis

The subdivision-level map gave me a much better understanding of the differences within these counties. While the county-level map showed one estimate for each county, the subdivision map revealed that some areas were much younger or older than others. Across the subdivisions I examined, the median age ranged from approximately 28 to 70 years old.

Some of the older subdivisions appeared in Loudon, Roane, Blount, Sevier, and Grainger. One thing I noticed was that several areas with colleges and universities appeared to have younger populations. For example, the University of Tennessee is in Knox County, Carson-Newman University is in Jefferson County, and Maryville College is in Blount County. These schools may help explain why certain areas have younger populations.

However, not every subdivision followed the same pattern. Some counties had pockets of younger residents even though their overall median age was much higher. Roane County, for example, appeared to have mostly older subdivisions.

Reflection

Before beginning this analysis, I expected Knox County to have one of the youngest populations in the area. Having grown up there, I know how much of an impact the University of Tennessee has on Knoxville. However, I hadn’t really considered the other colleges and universities across East Tennessee and how they might influence the median age in surrounding communities.

For the most part, the results aligned with my expectations. I figured more rural counties would have older populations compared to Knoxville. People may move away from larger cities for more affordable housing, privacy, or to raise a family. At the same time, younger people may be drawn to Knoxville because of college, jobs, and entertainment.

What interested me most was how much information was hidden in the county-level map. Looking at one median age for an entire county doesn’t tell the full story. The subdivision map showed that communities within the same county could have very different age distributions. 

As a journalist, I would be interested in exploring where younger people are choosing to live in East Tennessee and whether housing affordability plays a role. I would compare median age with average rent and housing prices to see whether younger residents are concentrated in more affordable areas.

I would also want to talk with younger residents about why they chose certain communities. Are they staying close to college? Are they moving farther away from Knoxville because they can’t afford to live there? Or are they choosing smaller communities because of their lifestyle?

CODE 1

############################################################
# 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 <- "DP05_0018"

# 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(
      "Knox County, Tennessee",
      "Sevier County, Tennessee",
      "Blount County, Tennessee",
      "Loudon County, Tennessee",
      "Roane County, Tennessee",
      "Anderson County, Tennessee",
      "Union County, Tennessee",
      "Jefferson County, Tennessee",
      "Grainger 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/>",
  "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 2

############################################################
# 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 <- "DP05_0018"

# 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,
      "Knox|Union|Grainger|Jefferson|Sevier|Blount|Loudon|Roane|Anderson"
    )
  )
############################################################
# 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(
  "", 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
    )
  )

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
)