Advertisement
binkleym

Untitled

Apr 17th, 2024 (edited)
1,325
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
R 2.90 KB | None | 0 0
  1. library(tidyverse)
  2. library(tigris)
  3. library(scales)
  4. library(sf)
  5.  
  6. ### Plots the NWS Categorical Risk map for Middle TN for the given day
  7. ### Data from:  https://www.spc.noaa.gov/gis/
  8.  
  9. # Which day X categorical map do you want?  Valid input is "1", "2", or "3"
  10. # Note:  This yields the weather map for Thursday April 18, 2024
  11. day <- "2"
  12.  
  13. ### Limiting the map to just neighboring states to speed up rendering
  14. tn_neighboring_states <-
  15.   c("01", "05", "13", "17", "18", "21", "28", "29", "37", "39", "45", "47", "51")
  16.  
  17. ### Cache TIGRIS data to speed up future map renders
  18. options(tigris_use_cache = TRUE)
  19.  
  20. ### Bounding box for Mid-TN
  21. map_x_min <- -81.5
  22. map_x_max <- -90.5
  23. map_y_min <-  34.5
  24. map_y_max <-  37.0
  25.  
  26. ### Load shapefile with the given day's outlook from NOAA
  27. map_url <- paste("https://www.spc.noaa.gov/products/outlook/day", day, "otlk_cat.kmz", sep = "")
  28.  
  29. ### Create a local map using a bounding box, and change colors to their standard representation
  30. map_weather <- map_url %>% read_sf() %>% st_transform(crs = "NAD83")
  31.  
  32. # Pull the start/end valid dates for the map and convert from UTC to CST
  33. weather_start <- map_weather %>% st_drop_geometry() %>% select(begin) %>% unique() %>% pull(begin)
  34. weather_end   <- map_weather %>% st_drop_geometry() %>% select(end)   %>% unique() %>% pull(end)
  35.  
  36. ### Load state/county outline maps from TIGRIS
  37. map_county <-
  38.   tigris::counties() %>%
  39.   filter(STATEFP %in% tn_neighboring_states)
  40.  
  41. map_state <-
  42.   tigris::states()
  43.  
  44. weather_map <-
  45.   ggplot() +
  46.   theme_bw() +
  47.   theme(
  48.     plot.title      = element_text(hjust = 0.5, size = 24),
  49.     plot.subtitle   = element_text(hjust = 0.5, size = 16),
  50.     legend.title    = element_text(size = 16),
  51.     legend.text     = element_text(size = 15),
  52.     legend.position = "bottom",
  53.     legend.margin   = margin(-10, 0, 0, 0)
  54.   ) +
  55.   labs(x = "", y = "",
  56.        title = paste("NWS Day ", day, " Categorical Risk Map", sep = ""),
  57.        subtitle = paste("(valid from ", weather_start, " until ", weather_end, ")", sep = "")) +
  58.   geom_sf(data = map_weather, aes(fill = Name), color = "black", size = 0.2) +
  59.   geom_sf(data = map_county, fill = NA, size = 0.15) +
  60.   geom_sf(data = map_state, fill = NA, color = "black", size = 3) +
  61.   scale_fill_manual(
  62.     name = "Categorical Risk", drop = FALSE,
  63.     values = c(
  64.       "General Thunder" = "#c0e8c0",
  65.       "Marginal Risk"   = "#7fc57f",
  66.       "Slight Risk"     = "#f6f67f",
  67.       "Enhanced Risk"   = "#e6c27f",
  68.       "Moderate Risk"   = "#e67f7f",
  69.       "High Risk"       = "#ff7fff"
  70.     ),
  71.     limits = c(
  72.       "General Thunder", "Marginal Risk", "Slight Risk", "Enhanced Risk", "Moderate Risk", "High Risk"
  73.     ),
  74.     labels = c(
  75.       "General Thunder", "Marginal Risk", "Slight Risk", "Enhanced Risk", "Moderate Risk", "High Risk"
  76.     )
  77.   ) +
  78.   coord_sf(xlim = c(map_x_min, map_x_max), ylim = c(map_y_min, map_y_max), expand = FALSE)
  79.  
  80. print(weather_map)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement