server <- function(input, output, session) { output$base_leaflet <- renderLeaflet({ leaflet() %>% addProviderTiles("Stadia.AlidadeSmooth") }) updateSliderInput( session, "dt_year_filter", min = dt_yr_range[1], max = dt_yr_range[2], value = dt_yr_range ) search_debounced <- debounce(reactive(input$table_search), 200) filtered_storms <- reactive({ data <- storm_coverage search <- search_debounced() if (!is.null(search) && nzchar(trimws(search))) { data <- data %>% filter(grepl(trimws(search), storm_name, ignore.case = TRUE)) } if (isTruthy(input$filter_cost)) { data <- data %>% filter(as.logical(has_cost_data)) } if (isTruthy(input$filter_fatality)) { data <- data %>% filter(as.logical(has_fatality_data)) } yr <- input$dt_year_filter if (!is.null(yr)) { data <- data %>% filter(storm_year >= yr[1], storm_year <= yr[2]) } deaths <- input$dt_deaths_filter if (!is.null(deaths)) { min_d <- deaths[1] max_d <- deaths[2] data <- data %>% filter( (is.na(total_direct_deaths) & (is.na(min_d) | min_d == 0)) | (!is.na(total_direct_deaths) & (is.na(min_d) | total_direct_deaths >= min_d) & (is.na(max_d) | total_direct_deaths <= max_d)) ) } mmh_r <- input$dt_mmh_filter if (!is.null(mmh_r)) { min_mmh <- mmh_r[1] max_mmh <- mmh_r[2] data <- data %>% filter( (is.na(mmh) & (is.na(min_mmh) | min_mmh == 0)) | (!is.na(mmh) & (is.na(min_mmh) | mmh >= min_mmh) & (is.na(max_mmh) | mmh <= max_mmh)) ) } mmp_r <- input$dt_mmp_filter if (!is.null(mmp_r)) { min_mmp <- mmp_r[1] max_mmp <- mmp_r[2] data <- data %>% filter( (is.na(mmp) & (is.na(min_mmp) | min_mmp == 0)) | (!is.na(mmp) & (is.na(min_mmp) | mmp >= min_mmp) & (is.na(max_mmp) | mmp <= max_mmp)) ) } data }) output$dt_storm_badges <- renderUI({ div(HTML(dt_storm_selected()$data)) }) output$storm_coverage_table <- renderDT({ datatable( filtered_storms() %>% select( hurdatid, storm_name, storm_year, data, mmh, mmp, total_direct_deaths ), fillContainer = TRUE, rownames = F, escape = F, colnames = c( "HURDAT2 ID", "Storm Name", "Year", "Available Data", "MMH23", "MMP23", "Direct Deaths" ), selection = "single", options = list( order = list(4, 'desc'), searching = F, paging = F, info = T, lengthChange = F, dom = "ti" ) ) %>% formatCurrency(c("mmh", "mmp"), "$", digits = 0) }) dt_storm_selected <- reactive({ req(input$storm_coverage_table_rows_selected) filtered_storms()[input$storm_coverage_table_rows_selected, ] }) output$dt_max_category <- renderText({ if (!is.null(input$storm_coverage_table_rows_selected)) { if (is.na(dt_storm_selected()$max_category)) { "N/A" } else { paste( "Cat ", dt_storm_selected()$max_category ) } } }) output$dt_track_observations <- renderText({ if (!is.null(input$storm_coverage_table_rows_selected)) { if (is.na(dt_storm_selected()$total_observations)) { "N/A" } else { paste0( dt_storm_selected()$total_observations ) } } }) output$dt_max_windspeed <- renderText({ if (!is.null(input$storm_coverage_table_rows_selected)) { if (is.na(dt_storm_selected()$max_windspeed)) { "N/A" } else { paste( dt_storm_selected()$max_windspeed, "kts" ) } } }) output$dt_min_pressure <- renderText({ if (!is.null(input$storm_coverage_table_rows_selected)) { if (is.na(dt_storm_selected()$min_pressure)) { "N/A" } else { paste( dt_storm_selected()$min_pressure, "mb" ) } } }) output$dt_storm_name_year <- renderText({ if (is.null(input$storm_coverage_table_rows_selected)) { "Select a storm" } else { paste0( dt_storm_selected()$storm_name, " (", dt_storm_selected()$storm_year, ")" ) } }) normalized_loss_summary <- reactive({ req(input$storm_coverage_table_rows_selected) storm <- list( storm_year = dt_storm_selected()$storm_year, storm_name = dt_storm_selected()$storm_name ) get_latest_aggregate_loss(storm) }) output$dt_mmh_loss <- renderText({ normalized_loss_summary()$mmh #dollar( # normalized_loss_summary()$mmh, # prefix = "$", # scale_cut = cut_short_scale() #) }) output$selected_storm_name_year <- renderText({ if (is.null(storm_selection$storm_name)) { "Select a storm" } else { paste0( storm_selection$storm_name, " (", storm_selection$storm_year, ")" ) } }) observe({ req( storm_selection$storm_basin, storm_selection$storm_year, storm_selection$storm_name ) unique_lfs <- get_unique_lf_ids(storm_selection) updateVirtualSelect( session = session, "storm_overview_cost_index_lf_select", choices = prepare_choices(unique_lfs, full_lf_id, full_lf_id, lf_type), selected = unique_lfs$full_lf_id[1] ) updateSelectInput( session, "growth_trend_lf_select", choices = unique_lfs$full_lf_id, selected = unique_lfs$full_lf_id[1] ) updateSliderInput( session, "growth_trend_map_slider", min = storm_selection$storm_year, value = storm_selection$storm_year ) }) observeEvent(input$load_storm, { storm_selection$storm_basin <- "AL" storm_selection$storm_year <- dt_storm_selected()$storm_year storm_selection$storm_name <- dt_storm_selected()$storm_name hurdatid <- get_hurdat_id(storm_selection) storm_selection$hurdatid = hurdatid$hurdatid selected_storm <- paste0( dt_storm_selected()$storm_name, " (", dt_storm_selected()$storm_year, ")" ) nav_select("main_navbar", "Storm Explorer") }) output$all_storms_map <- renderLeaflet({ leaflet() %>% addProviderTiles("Stadia.AlidadeSmooth") %>% addCircleMarkers( data = all_conus_landfalls, lng = ~lon, lat = ~lat, radius = 2, popup = ~ paste0(storm_name, " ", storm_year), weight = 0, color = "blue", fillColor = "blue", fillOpacity = 0.5 ) %>% addCircles( data = all_conus_landfalls, lng = ~lon, lat = ~lat, radius = ~rmw_meters, popup = ~ paste0(storm_name, " ", storm_year), weight = 1, color = "blue", fillColor = "blue", fillOpacity = 0.05 ) }) output$cost_storms_map <- renderLeaflet({ leaflet() %>% addProviderTiles("Stadia.AlidadeSmooth") %>% addCircleMarkers( data = all_conus_landfalls, lng = ~lon, lat = ~lat, radius = 2, popup = ~ paste0(storm_name, " ", storm_year), weight = 0, color = "blue", fillColor = "blue", fillOpacity = 0.5 ) %>% addCircles( data = all_conus_landfalls, lng = ~lon, lat = ~lat, radius = ~rmw_meters, popup = ~ paste0(storm_name, " ", storm_year), weight = 1, color = "blue", fillColor = "blue", fillOpacity = 0.05 ) }) storm_track <- reactive({ req( storm_selection$storm_basin, storm_selection$storm_year, storm_selection$storm_name ) result <- get_hurdat_track(storm_selection) # HURDAT storm status # TD – Tropical cyclone of tropical depression intensity (< 34 knots) # TS – Tropical cyclone of tropical storm intensity (34-63 knots) # HU – Tropical cyclone of hurricane intensity (> 64 knots) # EX – Extratropical cyclone (of any intensity) # SD – Subtropical cyclone of subtropical depression intensity (< 34 knots) # SS – Subtropical cyclone of subtropical storm intensity (> 34 knots) # LO – A low that is neither a tropical cyclone, a subtropical cyclone, nor an extratropical cyclone (of any intensity) # WV – Tropical Wave (of any intensity) # DB – Disturbance (of any intensity) # Line Color Storm Type Status Pressure (mb) Wind (mph) Wind (knots) # Blue Subtropical Depression SD -- <=38 <=33 # Light Blue Subtropical Storm SS -- 39-73 34-63 # Green Tropical Depression (TD) TD -- <=38 <=33 # Yellow Tropical Storm (TS) TS 980+ 39-73 34-63 # Red Hurricane (Cat 1) HU <=980 74-95 64-82 # Pink Hurricane (Cat 2) HU 965-980 96-110 83-95 # Magenta Major Hurricane (Cat 3) HU 945-965 111-129 96-112 # Purple Major Hurricane (Cat 4) HU 920-945 130-156 113-136 # White Major Hurricane (Cat 5) HU <=920 157+ 137+ # Green dashed (- -) Wave/Low/Disturbance WV/LO/DB -- -- -- # Black hatched (++) Extratropical Cyclone EX -- -- -- # Category Sustained Windspeed (knots) # 1 64-82 # 2 83-95 # 3 96-112 # 4 113-136 # 5 137+ # Preprocess the track data with colors result <- result %>% mutate( hurricane_category = case_when( # Hurricane Cat 1 storm_status == "HU" & windspeed >= 64 & windspeed <= 82 ~ 1, # Hurricane Cat 2 storm_status == "HU" & windspeed >= 83 & windspeed <= 95 ~ 2, # Hurricane Cat 3 storm_status == "HU" & windspeed >= 96 & windspeed <= 112 ~ 3, # Hurricane Cat 4 storm_status == "HU" & windspeed >= 113 & windspeed <= 136 ~ 4, # Hurricane Cate 5 storm_status == "HU" & windspeed >= 137 ~ 5, ), line_color = case_when( # Tropical Depression - Green storm_status == "TD" ~ "#2AFF00", # Tropical Storm - Yellow storm_status == "TS" ~ "#FFD020", # Hurricane Cat 1 - Red hurricane_category == 1 ~ "#FF4343", # Hurricane Cat 2 - Pink hurricane_category == 2 ~ "#FF6FFF", # Hurricane Cat 3 - Magenta hurricane_category == 3 ~ "#FF23D3", # Hurricane Cat 4 - Purple hurricane_category == 4 ~ "#C916FF", # Hurricane Cate 5 - White hurricane_category == 5 ~ "#FFFFFF", # Extratropical Cyclone storm_status == "EX" ~ "#202020", # Subtropical Depression storm_status == "SD" ~ "#0055FF", # Subtropical Storm storm_status == "SS" ~ "#6CE2FF", # Low storm_status == "LO" ~ "#A1A1A1", # Wave storm_status == "WV" ~ "#A1A1A1", # Disturbance storm_status == "DB" ~ "#A1A1A1", # Missing TRUE ~ "#FF5C00" ), popup_category = case_when( storm_status == "TD" ~ "TD", storm_status == "TS" ~ "TS", hurricane_category == 1 ~ "H1", hurricane_category == 2 ~ "H2", hurricane_category == 3 ~ "H3", hurricane_category == 4 ~ "H4", hurricane_category == 5 ~ "H5", storm_status == "EX" ~ "EX", storm_status == "SD" ~ "SD", storm_status == "SS" ~ "SS", storm_status == "LO" ~ "LO", storm_status == "WV" ~ "WV", storm_status == "DB" ~ "DB", TRUE ~ "NA" ) ) %>% arrange(datetime) return(result) }) output$track_map <- renderLeaflet({ track_data <- storm_track() map <- leaflet() %>% addProviderTiles("Stadia.AlidadeSmooth") %>% fitBounds( lng1 = min(track_data$lon), lng2 = max(track_data$lon), lat1 = min(track_data$lat), lat2 = max(track_data$lat) ) map <- map %>% leaflet::addLegend( position = "bottomleft", colors = c( "#2AFF00", # TD "#FFD020", # TS "#FF4343", # Cat 1 "#FF6FFF", # Cat 2 "#FF23D3", # Cat 3 "#C916FF", # Cat 4 "#FFFFFF", # Cat 5 "#202020", # EX "#0055FF", # SD "#6CE2FF", # SS "#A1A1A1", # LO/WV/DB "#FF5C00" # Missing ), labels = c( "Tropical Depression (TD)", "Tropical Storm (TS)", "Hurricane Category 1", "Hurricane Category 2", "Hurricane Category 3", "Hurricane Category 4", "Hurricane Category 5", "Extratropical Cyclone (EX)", "Subtropical Depression (SD)", "Subtropical Storm (SS)", "Low/Wave/Disturbance (LO/WV/DB)", "Missing Data" ), opacity = 1, title = "Track Legend" ) if (nrow(track_data) >= 2) { for (i in 1:(nrow(track_data) - 1)) { segment_data <- track_data[i:(i + 1), ] map <- map %>% addPolylines( data = segment_data, lng = ~lon, lat = ~lat, weight = 2, color = track_data$line_color[i], opacity = 1 ) } } map <- map %>% addCircleMarkers( data = track_data, lng = ~lon, lat = ~lat, radius = 2, color = ~line_color, fillOpacity = 1, popup = ~ paste0( "DATE", "
", datetime, "
", "CATEGORY", "
", popup_category, "
", "WINDSPEED", "
", windspeed, "kt", "
", "PRESSURE", "
", pressure, "mb" ) ) landfall_data <- track_data %>% filter(record_identifier == "L") if (nrow(landfall_data) > 0) { map <- map %>% addCircleMarkers( data = landfall_data, lng = ~lon, lat = ~lat, radius = 5, weight = 0, color = ~line_color, fillColor = ~line_color, fillOpacity = 1, popup = ~ paste0( "LANDFALL", "
", "DATE", "
", datetime, "
", "CATEGORY", "
", popup_category, "
", "WINDSPEED", "
", windspeed, "kt", "
", "PRESSURE", "
", pressure, "mb", "
", "RMW", "
", rmw, "nm" ) ) %>% addCircles( data = landfall_data, lng = ~lon, lat = ~lat, radius = ~rmw_meters, weight = 2, color = ~line_color, fillColor = ~line_color, fillOpacity = 0.3, popup = ~ paste0( "LANDFALL", "
", "DATE", "
", datetime, "
", "CATEGORY", "
", popup_category, "
", "WINDSPEED", "
", windspeed, "kt", "
", "PRESSURE", "
", pressure, "mb", "
", "RMW", "
", rmw, "nm" ) ) } return(map) }) output$track_data <- renderDT({ datatable( fillContainer = TRUE, storm_track() %>% select( formatted_datetime, storm_status, lon, lat, rmw, pressure, windspeed ), rownames = F, colnames = c( "Date", "Status", "Lon", "Lat", "RMW", "Pressure", "Windspeed" ), selection = "none", options = list( pageLength = 1000, order = list(0, 'asc'), searching = F, paging = F, info = F, lengthChange = F, server = T ) ) }) output$track_met_chart <- renderDygraph({ track_data <- storm_track() ts_data <- track_data %>% select(datetime, windspeed, pressure) %>% rename(Windspeed = windspeed, Pressure = pressure) track_xts <- xts( ts_data %>% select(-datetime), order.by = ts_data$datetime ) g <- dygraph(track_xts) %>% dyAxis("y", label = "Windspeed (kt)") %>% dyAxis("y2", label = "Pressure (mb)", independentTicks = TRUE) %>% dySeries("Windspeed", axis = "y", color = "#4dabf7") %>% dySeries("Pressure", axis = "y2", color = "#f03e3e") %>% dyOptions(drawGrid = FALSE) %>% dyLegend(show = "always") Reduce( function(g, i) { g %>% dyShading( from = track_data$datetime[i], to = track_data$datetime[i + 1], color = paste0(track_data$line_color[i], "33") ) }, seq_len(nrow(track_data) - 1), init = g ) }) storm_yearly_normalization <- reactive({ req( storm_selection$storm_basin, storm_selection$storm_year, storm_selection$storm_name ) result <- get_all_normalized_cost_index(storm_selection) return(result) }) output$cost_index_chart <- renderDygraph({ req( storm_yearly_normalization(), input$storm_overview_cost_index_lf_select, input$storm_overview_cost_index_mmh_mmp, input$storm_overview_cost_index_scale, input$storm_overview_cost_index_y_scale ) if (input$storm_overview_cost_index_y_scale == "Log") { is_y_log <- T } else { is_y_log <- F } normalized_data <- storm_yearly_normalization() %>% rename( "MMH Index" = mmh_index, "MMH Loss" = mmh_loss, "MMP Index" = mmp_index, "MMP Loss" = mmp_loss ) selected_lf <- input$storm_overview_cost_index_lf_select selected_normalization <- input$storm_overview_cost_index_mmh_mmp selected_scale <- input$storm_overview_cost_index_scale method_map <- c("MMH", "MMP") selected_methods <- method_map[method_map %in% selected_normalization] if (selected_scale == "Index") { value_columns <- paste0(selected_methods, " Index") y_label <- "Cost Index" } else if (selected_scale == "Loss") { value_columns <- paste0(selected_methods, " Loss") y_label <- "Normalized Loss" } normalization_index <- normalized_data %>% filter( full_lf_id %in% selected_lf ) %>% mutate( normalization_year = as.Date(paste0(normalization_year, "-01-01")) ) %>% select( normalization_year, full_lf_id, all_of(value_columns) ) %>% pivot_wider( names_from = full_lf_id, values_from = all_of(value_columns), names_glue = "{full_lf_id} {.value}" ) normalization_index_ts <- normalization_index %>% select(-normalization_year) %>% xts(order.by = normalization_index$normalization_year) dygraph(normalization_index_ts, ylab = y_label) %>% dyOptions( colors = paletteer_d( "ggthemes::Classic_Purple_Gray_12", ncol(normalization_index - 1) ), fillGraph = T, fillAlpha = .2, labelsKMB = T, logscale = is_y_log ) %>% dyAxis("x", drawGrid = F) %>% dyLegend(show = "always", width = 400, hideOnMouseOut = FALSE) %>% dyRangeSelector() }) growth_counties <- reactive({ req( storm_selection$storm_basin, storm_selection$storm_year, storm_selection$storm_name, input$growth_trend_lf_select ) selected_lf <- input$growth_trend_lf_select counties <- get_normalized_metric_growth(storm_selection, selected_lf) result <- counties %>% #filter(year == 2024) %>% mutate( population_opacity = rescale( normalized_population, to = c(0.2, 0.8), from = range(normalized_population, na.rm = T) ), housing_opacity = rescale( normalized_housing, to = c(0.2, 0.8), from = range(normalized_housing, na.rm = T) ) ) %>% st_as_sf(wkt = "geom_wkt") return(result) }) output$growth_map <- renderLeaflet({ req( growth_counties(), input$growth_trend_map_slider, input$growth_map_metric ) counties_data <- growth_counties() combined_geom <- st_union(counties_data) growth_bbox <- st_bbox(combined_geom) growth_year <- input$growth_trend_map_slider growth_county_year <- counties_data %>% filter(year == growth_year) map <- leaflet() %>% addProviderTiles("Stadia.AlidadeSmooth") %>% fitBounds( lng1 = growth_bbox[["xmin"]], lng2 = growth_bbox[["xmax"]], lat1 = growth_bbox[["ymin"]], lat2 = growth_bbox[["ymax"]] ) if (input$growth_map_metric == "Population") { map <- map %>% addPolygons( data = growth_county_year, group = "counties", fillColor = "red", color = "red", fillOpacity = ~population_opacity, weight = 1, popup = ~name ) } else { map <- map %>% addPolygons( data = growth_county_year, group = "counties", fillColor = "blue", color = "blue", fillOpacity = ~housing_opacity, weight = 1, popup = ~name ) } return(map) }) observe({ req( growth_counties(), input$growth_trend_map_slider, input$growth_map_metric ) growth_year <- input$growth_trend_map_slider growth_county_year <- growth_counties() %>% filter( year == growth_year ) if (input$growth_map_metric == "Population") { leafletProxy("growth_map", data = growth_county_year) %>% clearGroup("counties") %>% addPolygons( group = "counties", fillColor = "red", color = "red", fillOpacity = ~population_opacity, weight = 1, popup = ~name ) } else { leafletProxy("growth_map", data = growth_county_year) %>% clearGroup("counties") %>% addPolygons( group = "counties", fillColor = "blue", color = "blue", fillOpacity = ~housing_opacity, weight = 1, popup = ~name ) } }) output$fatality_map <- renderLeaflet({ req( storm_selection$storm_basin, storm_selection$storm_year, storm_selection$storm_name ) fatalities <- get_fatality_map(storm_selection) 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 == "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 ) } global_max <- log1p(max(fatalities_mapped$fatality_count)) 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 = c(0, global_max) ) map <- map %>% addPolygons( data = cat_data, group = cat, fillColor = ~ pal(log1p(fatality_count)), fillOpacity = 0.8, color = cat_color, weight = 1, popup = ~ paste0(name, ": ", fatality_count) ) } map <- map %>% addLayersControl( baseGroups = active_categories, options = layersControlOptions(collapsed = FALSE) ) return(map) }) fatality_heatmap_data <- reactive({ req( storm_selection$storm_basin, storm_selection$storm_year, storm_selection$storm_name ) get_fatality_heatmap_data(storm_selection) }) output$fatality_heatmap <- renderPlotly({ data <- fatality_heatmap_data() heatmap_data <- data %>% 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 == "surge" ~ "Storm Surge", fatality_type == "tornado" ~ "Tornado", fatality_type == "unknown" ~ "Unknown", TRUE ~ NA_character_ ) ) %>% filter(!is.na(category)) %>% group_by(state_label, category) %>% summarize(n = sum(n), .groups = "drop") %>% complete( state_label, category = c( "Freshwater Flood", "Offshore", "Storm Surge", "Surf", "Tornado", "Unknown", "Wind" ), fill = list(n = 0) ) %>% mutate( category = factor( category, levels = c( "Freshwater Flood", "Offshore", "Storm Surge", "Surf", "Tornado", "Wind", "Unknown" ) ), state_label = factor( state_label, levels = c(sort(setdiff(unique(state_label), "Unknown")), "Unknown") ) ) plot_ly( data = heatmap_data, x = ~category, y = ~state_label, z = ~n, type = "heatmap", colorscale = "Reds", showscale = FALSE, text = ~n, texttemplate = "%{text}", hovertemplate = "%{y} \u2014 %{x}: %{z}" ) %>% layout( xaxis = list(title = ""), yaxis = list(title = ""), margin = list(l = 60, r = 10, t = 10, b = 40) ) %>% config(displayModeBar = FALSE) }) output$fatality_pie <- renderPlotly({ data <- fatality_heatmap_data() pie_data <- data %>% 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 == "surge" ~ "Storm Surge", fatality_type == "tornado" ~ "Tornado", fatality_type == "unknown" ~ "Unknown", TRUE ~ NA_character_ ) ) %>% filter(!is.na(category)) %>% group_by(category) %>% summarise(n = sum(n), .groups = "drop") %>% filter(n > 0) category_colors <- c( "Wind" = "#cd2626", "Surf" = "#4f94cd", "Offshore" = "#5cacee", "Storm Surge" = "#4682b4", "Freshwater Flood" = "#36648b", "Tornado" = "#8b1a1a", "Unknown" = "#ffa500" ) plot_ly( data = pie_data, labels = ~category, values = ~n, type = "pie", marker = list(colors = unname(category_colors[pie_data$category])), textinfo = "label+value", hovertemplate = "%{label}: %{value}" ) %>% layout( legend = list(orientation = "h", x = 0.5, xanchor = "center", y = -0.1), margin = list(l = 10, r = 10, t = 10, b = 10) ) %>% config(displayModeBar = FALSE) }) }