segmentation_ggiraph.R

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)
                 )