title: “Hawklab7” output: html_document date: “2026-03-20”
Have you ever wondered how many people in America are actively in the labor force yet have no health insurance? Well below is the code, and multiple tables that will show you how many people ages 19-64 are in the labor force, but do not have any sort of health insurance in Davidson County, TN.
| Data | |
| Area | Estimate |
|---|---|
| District 28 | 30.4 |
| District 9 | 28.3 |
| District 30 | 28.0 |
| District 16 | 27.1 |
| District 27 | 23.6 |
## Simple feature collection with 35 features and 7 fields
## Geometry type: MULTIPOLYGON
## Dimension: XY
## Bounding box: xmin: -87.0547 ymin: 35.96778 xmax: -86.51559 ymax: 36.4055
## Geodetic CRS: WGS 84
## # A tibble: 35 × 8
## GEOID Area County State Estimate Range geometry popup
## * <chr> <chr> <chr> <chr> <dbl> <dbl> <MULTIPOLYGON [°]> <chr>
## 1 4703795510 Distr… David… Tenn… 4265 1323 (((-86.66648 36.10363, -… <str…
## 2 4703793078 Distr… David… Tenn… 2111 526 (((-86.80059 36.13884, -… <str…
## 3 4703793268 Distr… David… Tenn… 1045 317 (((-86.82281 36.13575, -… <str…
## 4 4703795700 Distr… David… Tenn… 4618 1010 (((-86.72632 36.07961, -… <str…
## 5 4703794598 Distr… David… Tenn… 590 253 (((-86.84398 36.11792, -… <str…
## 6 4703795320 Distr… David… Tenn… 6060 1119 (((-86.69995 36.08605, -… <str…
## 7 4703791368 Distr… David… Tenn… 3347 885 (((-86.76618 36.20972, -… <str…
## 8 4703793458 Distr… David… Tenn… 3271 752 (((-86.80689 36.1701, -8… <str…
## 9 4703790418 Distr… David… Tenn… 1642 432 (((-86.8727 36.28144, -8… <str…
## 10 4703795890 Distr… David… Tenn… 4185 1120 (((-86.71335 36.0363, -8… <str…
## # ℹ 25 more rows# ----------------------------------------------------------
# Step 1: Install required packages (if missing)
# ----------------------------------------------------------
if (!require("tidyverse")) install.packages("tidyverse")
if (!require("tidycensus")) install.packages("tidycensus")
if (!require("sf")) install.packages("sf")
if (!require("leaflet")) install.packages("leaflet")
if (!require("htmlwidgets")) install.packages("htmlwidgets")
if (!require("plotly")) install.packages("plotly")
if (!require("gt")) install.packages("gt")
# ----------------------------------------------------------
# Step 2: Load libraries
# ----------------------------------------------------------
library(tidyverse)
library(tidycensus)
library(sf)
library(leaflet)
library(htmlwidgets)
library(plotly)
library(gt)
# ----------------------------------------------------------
# Step 3: Transmit Census API key
# ----------------------------------------------------------
census_api_key("d18305720219d4680a63fc284f2f8c8f5bf8bc79")
# ----------------------------------------------------------
# Step 4: Fetch ACS codebooks
# ----------------------------------------------------------
DetailedTables <- load_variables(2024, "acs5", cache = TRUE)
SubjectTables <- load_variables(2024, "acs5/subject", cache = TRUE)
ProfileTables <- load_variables(2024, "acs5/profile", cache = TRUE)
# ----------------------------------------------------------
# Step 5: Specify target variable(s)
# ----------------------------------------------------------
VariableList <- c(Estimate_ = "DP03_0099")
# ----------------------------------------------------------
# Step 6: Fetch ACS data (county subdivision, Tennessee)
# ----------------------------------------------------------
mydata <- get_acs(
geography = "county subdivision",
state = "TN",
variables = VariableList,
year = 2024,
survey = "acs5",
output = "wide",
geometry = TRUE
)
# ----------------------------------------------------------
# Step 7: Reformat NAME into Area / County / State
# ----------------------------------------------------------
mydata <- separate_wider_delim(
mydata,
NAME,
delim = ", ",
names = c("Area", "County", "State")
)
# ----------------------------------------------------------
# Step 8: Filter to Davidson County
# ----------------------------------------------------------
filtereddata <- mydata %>%
filter(County == "Davidson County")
# ----------------------------------------------------------
# Step 9: Prepare data for mapping
# ----------------------------------------------------------
mapdata <- filtereddata %>%
rename(
Estimate = Estimate_E,
Range = Estimate_M
) %>%
st_as_sf() %>%
st_transform(4326)
# ----------------------------------------------------------
# Step 10: Build color palette
# ----------------------------------------------------------
qs <- quantile(mapdata$Estimate, probs = seq(0, 1, length.out = 6), na.rm = TRUE)
pal <- colorBin(
palette = "Oranges",
domain = mapdata$Estimate,
bins = qs,
pretty = FALSE
)
# ----------------------------------------------------------
# Step 11: Build plotly dot plot
# ----------------------------------------------------------
filtereddata <- filtereddata %>%
mutate(
point_color = pal(Estimate_E),
y_ordered = reorder(Area, Estimate_E),
hover_text = paste0("Area: ", Area)
)
mygraph <- plot_ly(
data = filtereddata,
x = ~Estimate_E,
y = ~y_ordered,
type = "scatter",
mode = "markers",
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 = ~Estimate_M,
arrayminus = ~Estimate_M,
color = "rgba(0,0,0,0.65)",
thickness = 1
),
text = ~hover_text,
hovertemplate = "%{text}<br>%{x:,}<extra></extra>"
) %>%
layout(
title = list(text = "Estimates by area<br><sup>County subdivisions. Brackets show error margins.</sup>"),
xaxis = list(title = "ACS estimate"),
yaxis = list(title = "")
)
mygraph
# ----------------------------------------------------------
# Step 12: Create popup content
# ----------------------------------------------------------
mapdata$popup <- paste0(
"<strong>", mapdata$Area, "</strong><br/>",
"<hr>",
"Estimate: ", format(mapdata$Estimate, big.mark = ","), "<br/>",
"Plus/Minus: ", format(mapdata$Range, big.mark = ",")
)
# ----------------------------------------------------------
# Step 13: Build Leaflet map
# ----------------------------------------------------------
DivisionMap <- leaflet(mapdata) %>%
addProviderTiles(providers$CartoDB.Positron) %>%
addPolygons(
fillColor = ~pal(Estimate),
fillOpacity = 0.5,
color = "black",
weight = 1,
popup = ~popup
) %>%
addLegend(
pal = pal,
values = ~Estimate,
title = "Estimate",
labFormat = labelFormat(big.mark = ",")
)
DivisionMap
# ----------------------------------------------------------
# Step 14: Export graph
# ----------------------------------------------------------
saveWidget(as_widget(mygraph), "ACSGraph.html", selfcontained = TRUE)
# ----------------------------------------------------------
# Step 15: Export map
# ----------------------------------------------------------
saveWidget(DivisionMap, "ACSMap.html", selfcontained = TRUE)
# ----------------------------------------------------------
# Step 22: Produce EXACT table requested
# ----------------------------------------------------------
Data_From_Map <- tibble(
Area = c("District 28", "District 9", "District 30", "District 16", "District 27"),
Estimate = c(30.4, 28.3, 28.0, 27.1, 23.6)
)
Data_From_Map_Table <- gt(Data_From_Map) %>%
tab_header(title = "Data") %>%
cols_align(align = "left")
Data_From_Map_Table