Skip to content

Instantly share code, notes, and snippets.

@walkerke
Created April 10, 2024 14:58
Show Gist options
  • Save walkerke/bcbc883ae8d204b0319427bbbee3f794 to your computer and use it in GitHub Desktop.
Save walkerke/bcbc883ae8d204b0319427bbbee3f794 to your computer and use it in GitHub Desktop.
library(tidycensus)
library(tigris)
library(tidyverse)
library(sf)
library(ggiraph)
library(patchwork)
options(tigris_use_cache = TRUE)
set.seed(123456)
# Get a list of counties within the Austin CBSA using tigris
austin_counties <- counties(year = 2021) %>%
filter(CBSAFP == "12420") %>%
pull(COUNTYFP)
# Pull data on income, age, and total population from tidycensus,
# then compute population density
austin_inputs <- get_acs(
geography = "tract",
variables = c(median_income = "B19013_001",
median_age = "B01002_001",
total_population = "B01003_001"),
state = "TX",
county = austin_counties,
output = "wide",
geometry = TRUE,
keep_geo_vars = TRUE
) %>%
mutate(pop_density = total_populationE / (ALAND / 2589988.11 )) %>%
na.omit()
# Use k-means to cluster Census tracts by demographic characteristics
austin_kmeans <- austin_inputs %>%
st_drop_geometry() %>%
select(median_incomeE, median_ageE, pop_density) %>%
scale() %>%
kmeans(centers = 6)
austin_clusters <- austin_inputs %>%
mutate(cluster = as.character(austin_kmeans$cluster))
# Build a map of clusters with ggplot2, ready for use with ggiraph
austin_map <- ggplot(austin_clusters, aes(fill = cluster, data_id = GEOID)) +
geom_sf_interactive(size = 0.1) +
scale_fill_brewer(palette = "Set1") +
theme_void() +
labs(fill = "Cluster ")
# Make a scatterplot of cluster characteristics for linking to the map
austin_plot <- ggplot(austin_clusters,
aes(x = median_incomeE, y = pop_density, color = cluster, data_id = GEOID)) +
geom_point_interactive() +
scale_color_brewer(palette = "Set1") +
scale_y_log10() +
scale_x_continuous(labels = scales::dollar_format()) +
theme_minimal(base_size = 12) +
labs(color = "Cluster",
x = "Median household income",
y = "Population density (logged)")
# Use ggiraph and patchwork to allow for linked brushing - it just works!
girafe(ggobj = austin_map + austin_plot, width_svg = 10, height_svg = 5.5) %>%
girafe_options(opts_zoom(min = 1, max = 8),
opts_selection(
css = "fill:cyan;",
only_shiny = FALSE)
)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment