modify fatality map layers

app/server.R

@@ -841,19 +841,68 @@ server <- function(input, output, session) {
 
     fatalities <- get_fatality_map(storm_selection)
 
-    fatalities <- fatalities %>%
+    category_colors <- c(
-      st_as_sf(wkt = "geom_wkt")
+      "Wind"             = "#cd2626",
+      "Surf"             = "#4f94cd",
+      "Offshore"         = "#5cacee",
+      "Storm Surge"      = "#4682b4",
+      "Freshwater Flood" = "#36648b",
+      "Tornado"          = "#8b1a1a",
+      "Unknown"          = "#ffa500"
+    )
+
+    state_geoms <- fatalities %>% distinct(state_fips, name, geom_wkt)
+
+    fatalities_mapped <- fatalities %>%
+      mutate(
+        category = case_when(
+          fatality_type %in% c("wind", "tree_fall") ~ "Wind",
+          fatality_type %in% c("surf", "rip_current") ~ "Surf",
+          fatality_type == "freshwater_floods" ~ "Freshwater Flood",
+          fatality_type == "offshore" ~ "Offshore",
+          fatality_type == "storm_surge" ~ "Storm Surge",
+          fatality_type == "tornado" ~ "Tornado",
+          fatality_type == "unknown" ~ "Unknown",
+          TRUE ~ NA_character_
+        )
+      ) %>%
+      filter(!is.na(category)) %>%
+      group_by(state_fips, category) %>%
+      summarise(fatality_count = sum(fatality_count), .groups = "drop") %>%
+      left_join(state_geoms, by = "state_fips") %>%
+      st_as_sf(wkt = "geom_wkt", crs = 4326)
+
+    active_categories <- intersect(names(category_colors), unique(fatalities_mapped$category))
 
     map <- leaflet() %>%
       addProviderTiles("Stadia.AlidadeSmooth")
 
+    tint <- function(hex, factor = 0.8) {
+      v <- col2rgb(hex) / 255
+      rgb(v[1] + (1 - v[1]) * factor, v[2] + (1 - v[2]) * factor, v[3] + (1 - v[3]) * factor)
+    }
+
+    for (cat in active_categories) {
+      cat_data <- fatalities_mapped %>% filter(category == cat)
+      cat_color <- category_colors[[cat]]
+      pal <- colorNumeric(c(tint(cat_color), cat_color), domain = cat_data$fatality_count)
+
+      map <- map %>%
+        addPolygons(
+          data = cat_data,
+          group = cat,
+          fillColor = ~pal(fatality_count),
+          fillOpacity = 0.7,
+          color = cat_color,
+          weight = 1,
+          popup = ~paste0(name, ": ", fatality_count)
+        )
+    }
+
     map <- map %>%
-      addPolygons(
+      addLayersControl(
-        data = fatalities %>% filter(fatality_type == "freshwater_floods"),
+        baseGroups = active_categories,
-        group = "Freshwater Floods",
+        options = layersControlOptions(collapsed = FALSE)
-        fillColor = "red",
-        color = "red",
-        weight = 1,
       )
 
     return(map)

app/ui.R

@@ -249,12 +249,8 @@ ui <- page_navbar(
           col_widths = c(8, 4),
           card(
             full_screen = TRUE,
-            layout_sidebar(
+            card_body(
               class = "p-0",
-              sidebar = sidebar(
-                actionButton("hi", "test"),
-                open = "always"
-              ),
               leafletOutput("fatality_map", height = "100%")
             )
           ),