# ============================================================
# 0. INSTALL AND LOAD REQUIRED PACKAGES
# ============================================================
if (!require("tidyverse")) install.packages("tidyverse")Loading required package: tidyverse── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr 1.1.4 ✔ readr 2.1.6
✔ forcats 1.0.1 ✔ stringr 1.6.0
✔ ggplot2 4.0.1 ✔ tibble 3.3.0
✔ lubridate 1.9.4 ✔ tidyr 1.3.1
✔ purrr 1.2.0
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag() masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorsif (!require("tidycensus")) install.packages("tidycensus")Loading required package: tidycensusif (!require("sf")) install.packages("sf")Loading required package: sf
Linking to GEOS 3.8.0, GDAL 3.0.4, PROJ 6.3.1; sf_use_s2() is TRUEif (!require("leaflet")) install.packages("leaflet")Loading required package: leafletif (!require("leaflet.extras2")) install.packages("leaflet.extras2")Loading required package: leaflet.extras2if (!require("gt")) install.packages("gt")Loading required package: gtif (!require("gtExtras")) install.packages("gtExtras")Loading required package: gtExtrasif (!require("plotly")) install.packages("plotly")Loading required package: plotly
Attaching package: 'plotly'
The following object is masked from 'package:ggplot2':
last_plot
The following object is masked from 'package:stats':
filter
The following object is masked from 'package:graphics':
layoutlibrary(tidyverse)
library(tidycensus)
library(sf)
library(leaflet)
library(leaflet.extras2)
library(gt)
library(gtExtras)
library(plotly)
# ============================================================
# 1. CENSUS API KEY
# ============================================================
census_api_key("494018a70f114d4f76b10537730ccc9c7dbfe36b")To install your API key for use in future sessions, run this function with `install = TRUE`.# ============================================================
# 2. LOAD ACS CODEBOOKS
# ============================================================
DetailedTables <- load_variables(2023, "acs5", cache = TRUE)
SubjectTables <- load_variables(2023, "acs5/subject", cache = TRUE)
ProfileTables <- load_variables(2023, "acs5/profile", cache = TRUE)
# ============================================================
# 3. DEFINE VARIABLES OF INTEREST
# ============================================================
VariableList <- c(
Count_ = "DP02_0059",
Percent_ = "DP02_0068P"
)
# ============================================================
# 4. FETCH COUNTY SUBDIVISION DATA (TENNESSEE)
# ============================================================
mydata <- get_acs(
geography = "county subdivision",
state = "TN",
variables = VariableList,
year = 2023,
survey = "acs5",
output = "wide",
geometry = TRUE
)Getting data from the 2019-2023 5-year ACS
Downloading feature geometry from the Census website. To cache shapefiles for use in future sessions, set `options(tigris_use_cache = TRUE)`.
Using the ACS Data Profile
|
| | 0%
|
|= | 1%
|
|= | 2%
|
|== | 3%
|
|=== | 4%
|
|=== | 5%
|
|==== | 5%
|
|==== | 6%
|
|===== | 7%
|
|====== | 9%
|
|======= | 10%
|
|======== | 11%
|
|======== | 12%
|
|========= | 13%
|
|========== | 14%
|
|=========== | 15%
|
|=========== | 16%
|
|============ | 18%
|
|============= | 19%
|
|============== | 20%
|
|=============== | 21%
|
|=============== | 22%
|
|================ | 23%
|
|================= | 24%
|
|================== | 25%
|
|================== | 26%
|
|=================== | 27%
|
|==================== | 28%
|
|===================== | 29%
|
|===================== | 30%
|
|====================== | 32%
|
|======================= | 33%
|
|======================== | 34%
|
|======================== | 35%
|
|========================= | 36%
|
|========================== | 37%
|
|========================== | 38%
|
|=========================== | 39%
|
|============================ | 40%
|
|============================= | 41%
|
|============================= | 42%
|
|============================== | 43%
|
|=============================== | 44%
|
|================================ | 45%
|
|================================ | 46%
|
|================================= | 47%
|
|================================== | 48%
|
|=================================== | 49%
|
|=================================== | 50%
|
|==================================== | 52%
|
|===================================== | 53%
|
|====================================== | 54%
|
|====================================== | 55%
|
|======================================= | 56%
|
|======================================== | 57%
|
|========================================= | 58%
|
|========================================= | 59%
|
|========================================== | 60%
|
|=========================================== | 61%
|
|=========================================== | 62%
|
|============================================ | 63%
|
|============================================= | 64%
|
|============================================== | 65%
|
|============================================== | 66%
|
|=============================================== | 67%
|
|================================================ | 68%
|
|================================================= | 69%
|
|================================================= | 71%
|
|================================================== | 72%
|
|=================================================== | 73%
|
|==================================================== | 74%
|
|==================================================== | 75%
|
|===================================================== | 76%
|
|====================================================== | 77%
|
|======================================================= | 78%
|
|======================================================= | 79%
|
|======================================================== | 80%
|
|========================================================= | 81%
|
|========================================================= | 82%
|
|========================================================== | 83%
|
|=========================================================== | 84%
|
|============================================================ | 85%
|
|============================================================ | 86%
|
|============================================================= | 87%
|
|============================================================== | 88%
|
|=============================================================== | 89%
|
|=============================================================== | 91%
|
|================================================================ | 92%
|
|================================================================= | 93%
|
|================================================================== | 94%
|
|================================================================== | 95%
|
|=================================================================== | 96%
|
|==================================================================== | 97%
|
|===================================================================== | 98%
|
|===================================================================== | 99%
|
|======================================================================| 100%# ============================================================
# 5. CLEAN AND REFORMAT GEOGRAPHIC NAMES
# ============================================================
mydata <- mydata %>%
separate_wider_delim(
NAME,
delim = ", ",
names = c("Division", "County", "State")
) %>%
mutate(County = str_remove(County, " County"))
# ============================================================
# NOTE: Sections 6 through 8 of this script have been omitted.
# See "Practical R (Part 1)" for those sections.
# ============================================================
# ============================================================
# 9. FILTER DATA FOR MULTI-COUNTY AREA
# ============================================================
CountyNameList <- c(
"Cannon","Cheatham","Davidson","Dickson","Hickman",
"Macon","Maury","Robertson","Rutherford","Smith",
"Sumner","Trousdale","Williamson","Wilson"
)
filtereddata2 <- mydata %>%
filter(County %in% CountyNameList)
# ============================================================
# 10. MAP MULTI-COUNTY AREA (WITH COUNTY BORDERS)
# ============================================================
mapdata2 <- filtereddata2 %>%
rename(
Percent = Percent_E,
PercentEM = Percent_M,
Count = Count_E,
CountEM = Count_M
) %>%
st_as_sf() %>%
st_transform(4326)
# Get Tennessee county boundaries for overlay
county_borders <- get_acs(
geography = "county",
state = "TN",
variables = "B01001_001", # dummy population variable
year = 2023,
geometry = TRUE
) %>%
st_as_sf() %>%
st_transform(4326) %>%
mutate(County = str_remove(NAME, " County, Tennessee")) %>%
filter(County %in% CountyNameList)Getting data from the 2019-2023 5-year ACS
Downloading feature geometry from the Census website. To cache shapefiles for use in future sessions, set `options(tigris_use_cache = TRUE)`.
|
| | 0%
|
| | 1%
|
|= | 1%
|
|= | 2%
|
|== | 2%
|
|== | 3%
|
|== | 4%
|
|=== | 4%
|
|=== | 5%
|
|==== | 5%
|
|==== | 6%
|
|===== | 6%
|
|===== | 7%
|
|===== | 8%
|
|====== | 8%
|
|====== | 9%
|
|======= | 9%
|
|======= | 10%
|
|======= | 11%
|
|======== | 11%
|
|======== | 12%
|
|========= | 12%
|
|========= | 13%
|
|========= | 14%
|
|========== | 14%
|
|========== | 15%
|
|=========== | 15%
|
|=========== | 16%
|
|============ | 16%
|
|============ | 17%
|
|============ | 18%
|
|============= | 18%
|
|============= | 19%
|
|============== | 19%
|
|============== | 20%
|
|============== | 21%
|
|=============== | 21%
|
|=============== | 22%
|
|================ | 22%
|
|================ | 23%
|
|================ | 24%
|
|================= | 24%
|
|================= | 25%
|
|================== | 25%
|
|================== | 26%
|
|=================== | 26%
|
|=================== | 27%
|
|=================== | 28%
|
|==================== | 28%
|
|==================== | 29%
|
|===================== | 29%
|
|===================== | 30%
|
|===================== | 31%
|
|====================== | 31%
|
|====================== | 32%
|
|======================= | 32%
|
|======================= | 33%
|
|======================= | 34%
|
|======================== | 34%
|
|======================== | 35%
|
|========================= | 35%
|
|========================= | 36%
|
|========================== | 36%
|
|========================== | 37%
|
|========================== | 38%
|
|=========================== | 38%
|
|=========================== | 39%
|
|============================ | 39%
|
|============================ | 40%
|
|============================ | 41%
|
|============================= | 41%
|
|============================= | 42%
|
|============================== | 42%
|
|============================== | 43%
|
|============================== | 44%
|
|=============================== | 44%
|
|=============================== | 45%
|
|================================ | 45%
|
|================================ | 46%
|
|================================= | 46%
|
|================================= | 47%
|
|================================= | 48%
|
|================================== | 48%
|
|================================== | 49%
|
|=================================== | 49%
|
|=================================== | 50%
|
|=================================== | 51%
|
|==================================== | 51%
|
|==================================== | 52%
|
|===================================== | 52%
|
|===================================== | 53%
|
|===================================== | 54%
|
|====================================== | 54%
|
|====================================== | 55%
|
|======================================= | 55%
|
|======================================= | 56%
|
|======================================== | 56%
|
|======================================== | 57%
|
|======================================== | 58%
|
|========================================= | 58%
|
|========================================= | 59%
|
|========================================== | 59%
|
|========================================== | 60%
|
|========================================== | 61%
|
|=========================================== | 61%
|
|=========================================== | 62%
|
|============================================ | 62%
|
|============================================ | 63%
|
|============================================ | 64%
|
|============================================= | 64%
|
|============================================= | 65%
|
|============================================== | 65%
|
|============================================== | 66%
|
|=============================================== | 66%
|
|=============================================== | 67%
|
|=============================================== | 68%
|
|================================================ | 68%
|
|================================================ | 69%
|
|================================================= | 69%
|
|================================================= | 70%
|
|================================================= | 71%
|
|================================================== | 71%
|
|================================================== | 72%
|
|=================================================== | 72%
|
|=================================================== | 73%
|
|=================================================== | 74%
|
|==================================================== | 74%
|
|==================================================== | 75%
|
|===================================================== | 75%
|
|===================================================== | 76%
|
|====================================================== | 76%
|
|====================================================== | 77%
|
|====================================================== | 78%
|
|======================================================= | 78%
|
|======================================================= | 79%
|
|======================================================== | 79%
|
|======================================================== | 80%
|
|======================================================== | 81%
|
|========================================================= | 81%
|
|========================================================= | 82%
|
|========================================================== | 82%
|
|========================================================== | 83%
|
|========================================================== | 84%
|
|=========================================================== | 84%
|
|=========================================================== | 85%
|
|============================================================ | 85%
|
|============================================================ | 86%
|
|============================================================= | 86%
|
|============================================================= | 87%
|
|============================================================= | 88%
|
|============================================================== | 88%
|
|============================================================== | 89%
|
|=============================================================== | 89%
|
|=============================================================== | 90%
|
|=============================================================== | 91%
|
|================================================================ | 91%
|
|================================================================ | 92%
|
|================================================================= | 92%
|
|================================================================= | 93%
|
|================================================================= | 94%
|
|================================================================== | 94%
|
|================================================================== | 95%
|
|=================================================================== | 95%
|
|=================================================================== | 96%
|
|==================================================================== | 96%
|
|==================================================================== | 97%
|
|==================================================================== | 98%
|
|===================================================================== | 98%
|
|===================================================================== | 99%
|
|======================================================================| 99%
|
|======================================================================| 100%# Viridis color palette
pal <- colorNumeric(
palette = "viridis",
domain = mapdata2$Percent
)
# Build leaflet map with county borders
DivisionMap2 <- leaflet(mapdata2) %>%
# Base maps
addProviderTiles("CartoDB.Positron", group = "Positron (Light)") %>%
addProviderTiles("Esri.WorldStreetMap", group = "ESRI Streets") %>%
addProviderTiles("Esri.WorldImagery", group = "ESRI Satellite") %>%
# Main polygons
addPolygons(
fillColor = ~pal(Percent),
fillOpacity = 0.7,
color = "#333333",
weight = 1,
group = "Data Layer",
popup = ~paste0(
"<b>", Division, "</b><br>",
"County: ", County, "<br>",
"Percent: ", Percent, "%<br>",
"Percent MOE: ±", PercentEM, "<br>",
"Count: ", Count, "<br>",
"Count MOE: ±", CountEM
)
) %>%
# County borders overlay
addPolylines(
data = county_borders,
color = "black",
weight = 1,
opacity = 0.8,
group = "County Borders"
) %>%
# Legend
addLegend(
pal = pal,
values = mapdata2$Percent,
position = "topright",
title = "Percent"
) %>%
addLayersControl(
baseGroups = c(
"Positron (Light)",
"ESRI Streets",
"ESRI Satellite"
),
overlayGroups = c("Data Layer", "County Borders"),
options = layersControlOptions(
collapsed = TRUE,
position = "bottomleft" # 👈 Control position
)
)
DivisionMap2# ============================================================
# 11. COUNTY-LEVEL TABLE FOR SELECTED COUNTIES
# ============================================================
CountyLevelData <- get_acs(
geography = "county",
state = "TN",
variables = VariableList,
year = 2023,
survey = "acs5",
output = "wide",
geometry = FALSE
)Getting data from the 2019-2023 5-year ACS
Using the ACS Data ProfileSelectedCounties <- CountyLevelData %>%
mutate(NAME = str_remove(NAME, " County, Tennessee")) %>%
filter(NAME %in% CountyNameList) %>%
select(NAME, Percent_E, Percent_M, Count_E, Count_M) %>%
rename(
County = NAME,
Percent = Percent_E,
PctMOE = Percent_M,
Count = Count_E,
CountMOE = Count_M
) %>%
arrange(desc(Percent))
CountyTable <- SelectedCounties %>%
gt() %>%
gt_theme_espn() %>%
cols_label(
Percent = "Percent (%)",
PctMOE = "Percent MOE",
Count = "Count",
CountMOE = "Count MOE"
) %>%
fmt_number(columns = c(Percent, PctMOE), decimals = 1) %>%
fmt_number(columns = c(Count), decimals = 0, use_seps = TRUE) %>%
tab_header(
title = "Estimates by County",
subtitle = "(2019–2023 ACS 5-Year ACS)"
)
CountyTable| Estimates by County | ||||
| (2019–2023 ACS 5-Year ACS) | ||||
| County | Percent (%) | Percent MOE | Count | Count MOE |
|---|---|---|---|---|
| Williamson | 61.8 | 1.2 | 167,620 | 266 |
| Davidson | 47.3 | 0.7 | 493,272 | 113 |
| Wilson | 37.2 | 1.2 | 105,888 | 312 |
| Rutherford | 34.4 | 1.1 | 223,304 | 85 |
| Sumner | 32.6 | 1.2 | 138,609 | 121 |
| Maury | 26.5 | 1.5 | 73,091 | 272 |
| Cheatham | 25.1 | 2.3 | 29,614 | 147 |
| Dickson | 21.4 | 1.9 | 38,559 | 203 |
| Robertson | 21.1 | 1.6 | 50,891 | 165 |
| Smith | 17.9 | 2.3 | 14,180 | 77 |
| Cannon | 16.9 | 3.2 | 10,397 | 97 |
| Hickman | 13.6 | 2.2 | 18,044 | 107 |
| Macon | 11.8 | 2.3 | 17,135 | 251 |
| Trousdale | 10.1 | 2.7 | 8,490 | 285 |