Rationale

Learning how to utilize Census data in R Studio is a valuable tool. I’ve played around with it. My buddy Chat gave me a code to use to supplement this week’s lesson: income and education. I finally was able to get it to run a code to create an interactive map of the selected rural counties and I do have a table that lists income average coupled with the percentage of households with a four-year degree (bachelor’s).

Hypothesis

I decided to dabble in data crunching. For my procured section of data, I surmise the counties with higher percentages of college degrees (bachelor’s degree+) boast a higher median income than those with lower percentages of college degrees.

Variables & method

Thanks to my friend, Chat, I collected an additional data set for a select number of counties in lower Middle Tennessee. I was also curious whether those counties in lower Middle Tennessee — which can be considered rural — had lower percentages of college degrees.

Results & discussion

I got the maps to run, using a little tweaked code provided by my friend, Chat. I also proved my hypothesis about income and education level. The more you know (education), the more money you earn. Thus, everyone should get a college education.

I tried to put all the data in one R Markdown document. But I ended up having to rename graphics and maps. I wasn’t sure that altering the assignment and data was permissible. So I kept them separate.

Rural county maps/tables

Here is the Education Income interactive map.

Here is the income table.

2024 ACS: Income and Education in Nine Tennessee Counties
County Median Household Income Bachelor’s Degree or Higher
Rutherford $85,470 35.8%
Marshall $71,049 23.1%
Bedford $67,225 17.2%
Moore $66,469 24.1%
Lincoln $64,667 20.6%
Franklin $63,494 23.9%
Coffee $61,505 21.4%
Cannon $59,443 16.8%
Warren $55,487 14.1%

Here is the income plot graphic and a scatter plot (colorful but essentially useless).

Code

Here is the code I used to garner the results.

############################################################
# SCRIPT 2: INCOME AND EDUCATION COMPARISON
# 2024 ACS Five-Year Estimates
############################################################

############################################################
# STEP 1: Load Packages
############################################################

EducationPackages <- c(
  "tidycensus",
  "dplyr",
  "sf",
  "leaflet",
  "plotly",
  "knitr",
  "kableExtra",
  "htmlwidgets"
)

for (pkg in EducationPackages) {
  if (!requireNamespace(pkg, quietly = TRUE)) {
    install.packages(pkg)
  }
}

library(tidycensus)
library(dplyr)
library(sf)
library(leaflet)
library(plotly)
library(knitr)
library(kableExtra)
library(htmlwidgets)

############################################################
# STEP 2: Verify Census API Key
############################################################

EducationCensusKey <- Sys.getenv("CENSUS_API_KEY")

if (!nzchar(EducationCensusKey)) {
  stop("Census API key not found.")
}

############################################################
# STEP 3: Configure Analysis
############################################################

EducationACSYear <- 2024

EducationCounties <- c(
  "Bedford",
  "Rutherford",
  "Coffee",
  "Lincoln",
  "Franklin",
  "Moore",
  "Warren",
  "Marshall",
  "Cannon"
)

# Detailed ACS variables:
# B19013_001 = Median household income
# B15003_001 = Population age 25 and older
# B15003_022 = Bachelor's degree
# B15003_023 = Master's degree
# B15003_024 = Professional degree
# B15003_025 = Doctorate degree

EducationVariables <- c(
  Median_Income = "B19013_001",
  Total_Adults = "B15003_001",
  Bachelors = "B15003_022",
  Masters = "B15003_023",
  Professional = "B15003_024",
  Doctorate = "B15003_025"
)

############################################################
# STEP 4: Download Census Data
############################################################

EducationAllCounties <- tidycensus::get_acs(
  geography = "county",
  state = "TN",
  year = EducationACSYear,
  survey = "acs5",
  variables = EducationVariables,
  geometry = TRUE
)

############################################################
# STEP 5: Prepare Education and Income Data
############################################################

EducationWideData <- EducationAllCounties |>
  sf::st_drop_geometry() |>
  select(GEOID, variable, estimate) |>
  tidyr::pivot_wider(
    names_from = variable,
    values_from = estimate
  )

EducationGeometry <- EducationAllCounties |>
  filter(variable == "Median_Income") |>
  select(GEOID, NAME, geometry)

EducationMapData <- EducationGeometry |>
  left_join(
    EducationWideData,
    by = "GEOID"
  ) |>
  mutate(
    County = sub(" County, Tennessee$", "", NAME),
    Bachelors_Percent = 100 * (
      Bachelors + Masters + Professional + Doctorate
    ) / Total_Adults
  ) |>
  filter(County %in% EducationCounties) |>
  sf::st_transform(4326)

if (nrow(EducationMapData) != 9) {
  stop("Not all nine education counties were found.")
}

EducationComparisonData <- EducationMapData |>
  sf::st_drop_geometry() |>
  select(
    County,
    Median_Income,
    Bachelors_Percent
  ) |>
  arrange(desc(Median_Income))

############################################################
# STEP 6: Create Comparison Table
############################################################

EducationIncomeTable <- EducationComparisonData |>
  mutate(
    Median_Income = paste0(
      "$",
      format(
        Median_Income,
        big.mark = ",",
        scientific = FALSE,
        trim = TRUE
      )
    ),
    Bachelors_Percent = paste0(
      round(Bachelors_Percent, 1),
      "%"
    )
  ) |>
  knitr::kable(
    col.names = c(
      "County",
      "Median Household Income",
      "Bachelor's Degree or Higher"
    ),
    caption = paste(
      "2024 ACS: Income and Education",
      "in Nine Tennessee Counties"
    )
  ) |>
  kableExtra::kable_styling(
    bootstrap_options = c("striped", "hover"),
    full_width = FALSE
  )

############################################################
# STEP 7: Create Education Map Popups
############################################################

EducationMapData <- EducationMapData |>
  mutate(
    popup = paste0(
      "<strong>", County, " County</strong>",
      "<br>Bachelor's degree or higher: ",
      round(Bachelors_Percent, 1),
      "%",
      "<br>Median household income: $",
      format(Median_Income, big.mark = ",")
    )
  )

############################################################
# STEP 8: Create Education Color Palette
############################################################

EducationPalette <- leaflet::colorNumeric(
  palette = "Blues",
  domain = EducationMapData$Bachelors_Percent,
  na.color = "#cccccc"
)

############################################################
# STEP 9: Create Interactive Education Map
############################################################

EducationBounds <- sf::st_bbox(
  EducationMapData
)

EducationMap <- leaflet::leaflet(
  EducationMapData,
  width = "100%",
  height = 650
) |>
  leaflet::addTiles() |>
  leaflet::addPolygons(
    fillColor = ~EducationPalette(Bachelors_Percent),
    fillOpacity = 0.8,
    color = "black",
    weight = 1.5,
    popup = ~popup,
    highlightOptions = leaflet::highlightOptions(
      weight = 3,
      color = "#333333",
      fillOpacity = 0.9,
      bringToFront = TRUE
    )
  ) |>
  leaflet::addLegend(
    position = "bottomright",
    pal = EducationPalette,
    values = ~Bachelors_Percent,
    title = "Bachelor's Degree or Higher (%)",
    labFormat = leaflet::labelFormat(
      suffix = "%"
    )
  ) |>
  leaflet::fitBounds(
    lng1 = unname(EducationBounds["xmin"]),
    lat1 = unname(EducationBounds["ymin"]),
    lng2 = unname(EducationBounds["xmax"]),
    lat2 = unname(EducationBounds["ymax"])
  )

############################################################
# STEP 10: Prepare Education Dot Plot Data
############################################################

EducationPlotData <- EducationComparisonData |>
  mutate(
    County = reorder(
      County,
      Bachelors_Percent
    ),
    hover_text = paste0(
      County,
      " County",
      "<br>Bachelor's degree or higher: ",
      round(Bachelors_Percent, 1),
      "%",
      "<br>Median household income: $",
      format(Median_Income, big.mark = ",")
    )
  )

############################################################
# STEP 11: Create Education Dot Plot
############################################################

EducationDotPlot <- plotly::plot_ly(
  data = EducationPlotData,
  x = ~Bachelors_Percent,
  y = ~County,
  type = "scatter",
  mode = "markers",
  text = ~hover_text,
  hoverinfo = "text",
  marker = list(
    size = 10,
    color = "#2166ac"
  )
) |>
  plotly::layout(
    title = paste(
      "Educational Attainment",
      "Nine Tennessee Counties",
      sep = "<br>"
    ),
    xaxis = list(
      title = "Bachelor's Degree or Higher (%)",
      ticksuffix = "%"
    ),
    yaxis = list(
      title = "",
      automargin = TRUE
    ),
    margin = list(
      l = 120,
      r = 30,
      b = 70,
      t = 90
    )
  )

############################################################
# STEP 12: Create Income and Education Scatterplot
############################################################

EducationIncomeScatterPlot <- plotly::plot_ly(
  data = EducationComparisonData,
  x = ~Bachelors_Percent,
  y = ~Median_Income,
  type = "scatter",
  mode = "markers",
  text = ~County,
  hovertemplate = paste0(
    "%{text} County",
    "<br>Bachelor's degree or higher: %{x:.1f}%",
    "<br>Median household income: $%{y:,.0f}",
    "<extra></extra>"
  ),
  marker = list(
    size = 11,
    color = "#2166ac"
  )
) |>
  plotly::layout(
    title = "Education and Median Household Income",
    xaxis = list(
      title = "Bachelor's Degree or Higher (%)",
      ticksuffix = "%"
    ),
    yaxis = list(
      title = "Median Household Income ($)",
      tickprefix = "$",
      tickformat = ",.0f"
    )
  )

############################################################
# STEP 13: Export Results
############################################################

write.csv(
  EducationComparisonData,
  "Tennessee_Income_Education.csv",
  row.names = FALSE
)

if (interactive()) {
  htmlwidgets::saveWidget(
    EducationMap,
    "EducationMap.html",
    selfcontained = FALSE
  )
  
  htmlwidgets::saveWidget(
    EducationDotPlot,
    "EducationDotPlot.html",
    selfcontained = FALSE
  )
  
  htmlwidgets::saveWidget(
    EducationIncomeScatterPlot,
    "EducationIncomeScatterPlot.html",
    selfcontained = FALSE
  )
}

############################################################
# STEP 14: Display Results
############################################################

EducationIncomeTable
EducationMap
EducationDotPlot
EducationIncomeScatterPlot