Kyle Walker's Maps

library(tidycensus)
library(tigris)
library(tidyverse)
options(tigris_use_cache = TRUE)

# Grab the data
us_wfh <- get_acs(
  geography = "puma",
  variables = "DP03_0024P",
  year = 2022,
  survey = "acs1",
  geometry = TRUE,
  key = Sys.getenv("CENSUS_API_KEY")
)

# Interactive map with mapgl
library(mapgl)

# Format the popup
popup_content <- glue::glue("<strong>{us_wfh$NAME}</strong><br>",
                            "% working from home: {us_wfh$estimate}")

us_wfh$popup <- popup_content

# Build the interactive map
wfh_map <- mapboxgl(
  style = mapbox_style("light"),
  center = c(-98.5795, 39.8283),
  zoom = 3
) %>%
  add_fill_layer(
    id = "puma_wfh",
    source = us_wfh,
    fill_color = interpolate(
      column = "estimate",
      values = c(1.4, 9.4, 14.9, 22.2, 36.5),
      stops = viridisLite::plasma(5),
      na_color = "lightgrey"
    ),
    fill_opacity = 0.7,
    popup = "popup",
    hover_options = list(fill_color = "cyan", fill_opacity = 1)
  ) %>%
  add_legend(
    "% working from home by PUMA, 2023 1-year ACS",
    values = c("1.4%", "9.4%", "14.9%", "22.2%", "36.5%"),
    colors = viridisLite::plasma(5)
  )

wfh_map

# Save the map
# saveWidget(wfh_map, "wfh_map.html", selfcontained = FALSE)

library(tigris)
library(mapgl)
library(sf)
library(dplyr)
options(tigris_use_cache = TRUE)

manhattan_blocks <- blocks(year = 2020, state = "NY", county = "New York") |>
  dplyr::select(GEOID20, POP20) %>%
  erase_water() %>%
  dplyr::filter(sf::st_is(.$geometry, c("POLYGON", "MULTIPOLYGON")))

manhattan_3d <- mapboxgl(center = c(-73.9652, 40.7804),
         zoom = 11,
         pitch = 45,
         bearing = -74) %>%
  add_fill_extrusion_layer(
    id = "manhattan",
    source = manhattan_blocks,
    fill_extrusion_height = get_column("POP20"),
    fill_extrusion_opacity = 0.8,
    fill_extrusion_color = interpolate(
      column = "POP20",
      values = c(0, max(manhattan_blocks$POP20, na.rm = TRUE)),
      stops = c("pink", "maroon")
    ),
    tooltip = "POP20",
    hover_options = list(
      fill_extrusion_color = "lightgreen"
    )
  ) %>%
  add_legend(
    legend_title = "Block population in Manhattan, 2020",
    values = c(0, max(manhattan_blocks$POP20, na.rm = TRUE)),
    colors = c("pink", "maroon")
  )

manhattan_3d

# htmlwidgets::saveWidget(manhattan_3d, "manhattan_3d.html", selfcontained = FALSE)