diff --git a/app/server.R b/app/server.R index 3218a81..fb55592 100644 --- a/app/server.R +++ b/app/server.R @@ -841,19 +841,68 @@ server <- function(input, output, session) { fatalities <- get_fatality_map(storm_selection) - fatalities <- fatalities %>% - st_as_sf(wkt = "geom_wkt") + category_colors <- c( + "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( - data = fatalities %>% filter(fatality_type == "freshwater_floods"), - group = "Freshwater Floods", - fillColor = "red", - color = "red", - weight = 1, + addLayersControl( + baseGroups = active_categories, + options = layersControlOptions(collapsed = FALSE) ) return(map) diff --git a/app/ui.R b/app/ui.R index 954323a..1cadb50 100644 --- a/app/ui.R +++ b/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%") ) ),