update coloring functions for fatality map

This commit is contained in:
2026-04-09 16:34:16 -04:00
parent d6f6b26257
commit 91efb99dba
+8 -6
View File
@@ -861,7 +861,7 @@ server <- function(input, output, session) {
fatality_type %in% c("surf", "rip_current") ~ "Surf", fatality_type %in% c("surf", "rip_current") ~ "Surf",
fatality_type == "freshwater_floods" ~ "Freshwater Flood", fatality_type == "freshwater_floods" ~ "Freshwater Flood",
fatality_type == "offshore" ~ "Offshore", fatality_type == "offshore" ~ "Offshore",
fatality_type == "storm_surge" ~ "Storm Surge", fatality_type == "surge" ~ "Storm Surge",
fatality_type == "tornado" ~ "Tornado", fatality_type == "tornado" ~ "Tornado",
fatality_type == "unknown" ~ "Unknown", fatality_type == "unknown" ~ "Unknown",
TRUE ~ NA_character_ TRUE ~ NA_character_
@@ -890,20 +890,22 @@ server <- function(input, output, session) {
) )
} }
global_max <- log1p(max(fatalities_mapped$fatality_count))
for (cat in active_categories) { for (cat in active_categories) {
cat_data <- fatalities_mapped %>% filter(category == cat) cat_data <- fatalities_mapped %>% filter(category == cat)
cat_color <- category_colors[[cat]] cat_color <- category_colors[[cat]]
pal <- colorNumeric( pal <- colorNumeric(
c(tint(cat_color), cat_color), c(tint(cat_color), cat_color),
domain = cat_data$fatality_count domain = c(0, global_max)
) )
map <- map %>% map <- map %>%
addPolygons( addPolygons(
data = cat_data, data = cat_data,
group = cat, group = cat,
fillColor = ~ pal(fatality_count), fillColor = ~ pal(log1p(fatality_count)),
fillOpacity = 0.7, fillOpacity = 0.8,
color = cat_color, color = cat_color,
weight = 1, weight = 1,
popup = ~ paste0(name, ": ", fatality_count) popup = ~ paste0(name, ": ", fatality_count)
@@ -938,7 +940,7 @@ server <- function(input, output, session) {
fatality_type %in% c("surf", "rip_current") ~ "Surf", fatality_type %in% c("surf", "rip_current") ~ "Surf",
fatality_type == "freshwater_floods" ~ "Freshwater Flood", fatality_type == "freshwater_floods" ~ "Freshwater Flood",
fatality_type == "offshore" ~ "Offshore", fatality_type == "offshore" ~ "Offshore",
fatality_type == "storm_surge" ~ "Storm Surge", fatality_type == "surge" ~ "Storm Surge",
fatality_type == "tornado" ~ "Tornado", fatality_type == "tornado" ~ "Tornado",
fatality_type == "unknown" ~ "Unknown", fatality_type == "unknown" ~ "Unknown",
TRUE ~ NA_character_ TRUE ~ NA_character_
@@ -1009,7 +1011,7 @@ server <- function(input, output, session) {
fatality_type %in% c("surf", "rip_current") ~ "Surf", fatality_type %in% c("surf", "rip_current") ~ "Surf",
fatality_type == "freshwater_floods" ~ "Freshwater Flood", fatality_type == "freshwater_floods" ~ "Freshwater Flood",
fatality_type == "offshore" ~ "Offshore", fatality_type == "offshore" ~ "Offshore",
fatality_type == "storm_surge" ~ "Storm Surge", fatality_type == "surge" ~ "Storm Surge",
fatality_type == "tornado" ~ "Tornado", fatality_type == "tornado" ~ "Tornado",
fatality_type == "unknown" ~ "Unknown", fatality_type == "unknown" ~ "Unknown",
TRUE ~ NA_character_ TRUE ~ NA_character_