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)

library(climateR)

library(terra)

library(sf)
library(dplyr)
library(mapgl)
library(tigris)

# Get Texas boundary
tx <- states(resolution = "20m") %>%
  filter(STUSPS == "TX")

# Fetch GridMET data
tmmx_data <- getGridMET(
  AOI = tx,
  varname = "tmmx",
  startDate = "2024-11-04",
  endDate = "2024-11-04"
)

tmmx_rast <- tmmx_data$daily_maximum_temperature

# Convert temperature from Kelvin to Fahrenheit
tmmx_rast <- (tmmx_rast - 273.15) * 9/5 + 32

# Convert raster to polygons
tmmx_polygons <- as.polygons(tmmx_rast, aggregate = FALSE)
# Convert to sf object
tmmx_sf <- st_as_sf(tmmx_polygons)

# Ensure the CRS matches Texas boundary
tmmx_sf <- st_transform(tmmx_sf, st_crs(tx))

# Clip to Texas boundary
tmmx_sf <- st_intersection(tmmx_sf, tx) %>%
  transmute(temp = round(tmmx_2024.11.04, 2)) %>%
  select(temp) 

# Create the map
heat_map <- mapboxgl(
  style = mapbox_style("light"),
  bounds = tx, 
  customAttribution = '<a href="https://www.climatologylab.org/gridmet.html" target="_blank">Data source: GridMET</a>'
) %>%
  add_fill_layer(
    id = "temperature",
    source = tmmx_sf,
    fill_color = mapgl::interpolate(
      column = "temp",
      values = seq(min(tmmx_sf$temp, na.rm = TRUE), max(tmmx_sf$temp, na.rm = TRUE), length.out = 100),
      stops = viridisLite::inferno(100)
    ),
    fill_opacity = 0.8,
    tooltip = "temp"
  ) %>%
  add_line_layer(
    id = "state_border",
    source = tx,
    line_color = "black",
    line_width = 2
  ) %>%
  add_continuous_legend(
    legend_title = "High temperature in Texas, Nov 4 2024",
    values = c(sprintf("%.1f°F", min(tmmx_sf$temp, na.rm = TRUE)), 
               sprintf("%.1f°F", max(tmmx_sf$temp, na.rm = TRUE))),
    colors = viridisLite::inferno(100)
  )

heat_map

# library(tidycensus)
# library(tigris)
# library(cartogram)
# library(dplyr)
# library(mapgl)
# 
# us_county_pop <- get_estimates(
#   geography = "county",
#   vintage = 2023,
#   variables = c("POPESTIMATE", "RNETMIG"),
#   geometry = TRUE,
#   output = "wide"
# ) %>%
#   shift_geometry() %>%
#   mutate(pop_proportion = POPESTIMATE / sum(POPESTIMATE, na.rm = TRUE))
# 
# dorling <- cartogram_dorling(us_county_pop, "pop_proportion", k = 0.2, itermax = 100)
# 
# readr::write_rds(dorling, "dorling.rds")
# 
# style <- list(
#   version = 8,
#   sources = structure(list(), .Names = character(0)),
#   layers = list(
#     list(
#       id = "background",
#       type = "background",
#       paint = list(
#         `background-color` = "lightgrey"
#       )
#     )
#   )
# )
# 
# dorling <- readr::read_rds("dorling.rds") %>%
#   select(NAME, RNETMIG) %>%
#   mutate(NAME = utf8::utf8_encode(NAME)) %>%
#   mutate(tooltip = paste0("<b>", NAME, "</b><br>Net migration rate: ", round(RNETMIG, 2)))
# 
# 
# state_borders <- states(cb = TRUE, year = 2023, resolution = "20m") %>%
#   filter(GEOID != "72") %>%
#   shift_geometry()
# 
# 
# 
# dorling_map <- mapboxgl(style = style, projection = "albers",
#         center = c(-98.8, 37.68),
#         zoom = 2.5) |> 
#   add_source(
#     id = "dorling",
#     data = dorling,
#     tolerance = 0
#   ) |> 
#   add_line_layer(
#     id = "state_borders",
#     source = state_borders,
#     line_color = "black",
#     line_width = 0.5
#   ) |> 
#   add_fill_layer(
#     id = "dorling",
#     source = "dorling",
#     fill_color = mapgl::interpolate(
#       column = 'RNETMIG',
#       values = c(-50, 0, 67),
#       stops = c("#075af4", "#ffffff", "#f30303"),
#     ),
#     fill_outline_color = "black",
#     fill_opacity = 0.8,
#     tooltip = "tooltip",
#     hover_options = list(
#       fill_opacity = 1
#     )
#   ) |> 
#   mapgl::add_legend(
#     "<span style='font-weight: bold;'>Net migration rate, 2023</span><br><span style='font-size: 0.9em;'>Dorling cartogram of US counties; county positions may differ from actual locations</span>",
#      values = c("-50", "0", "+67"),
#      colors = c("#075af4", "#ffffff", "#f30303")
#   )
#  
# dorling_map