--- title: "Hurricane Normalization App" runtime: shiny output: flexdashboard::flex_dashboard: orientation: columns vertical_layout: fill theme: version: 4 bootswatch: litera --- ```{r global, include=FALSE} # TODO: # - update normalization to new 2024 data # - library(flexdashboard) library(shiny) library(leaflet) library(DT) library(dplyr) library(DBI) library(tidyr) library(ggplot2) library(plotly) library(viridis) library(lubridate) library(scales) library(readr) library(stringr) library(kableExtra) library(bslib) library(dygraphs) library(tidyverse) library(sf) library(shinyBS) library(xts) library(tigris) library(caret) library(scales) library(billboarder) library(shinyWidgets) library(paletteer) library(shinyjs) # local testing env setup os <- Sys.info()["sysname"] linuxdir <- "/home/dylan/Personal/Projects/Hurricane Normalization/" macdir <- "~/Desktop/Personal/Projects/Hurricane Normalization/" widir <- "E/..." if(!is.null(os)) { if(grepl("darwin", os, ignore.case = T)) { cat("OS: Mac") baseDir <- macdir } else if(grepl("linux", os, ignore.case = T)) { cat("OS: Linux") baseDir <- linuxdir } else if(grepl("windows", os, ignore.case = T)) { cat("OS: Win") baseDir <- windir } else { cat("Cannot identify OS") } } config <- config::get(file = paste0(baseDir, "R/dataScripts/restructured/app/config.yml")) source(file = paste0(baseDir, "R/dataScripts/restructured/app/queries.R")) useShinyjs() # pull static data loss_storms <- get_all_loss_storms() latest_normalized_losses <- get_latest_aggregate_losses() all_conus_landfalls <- get_all_conus_landfalls() storm_selection <- reactiveValues( storm_year = NULL, storm_name = NULL, storm_basin = NULL, ) onStop(function() { disconnect_db() }) ``` Home ============================================= Col {data-width=500} ---------------------------------------------- ### {} ```{r} # Home - Intro HTML( '

Welcome to the Hurricane Cost Normalization Web App

Our platform provides access to normalized hurricane damage data spanning from 1900 to 2024, allowing researchers, policymakers, insurance professionals, and the public to better understand how hurricane costs have changed over time.

Our Data

The core datasets used in this app are based on research by Muller et al. (2025) published in Bulletin of the American Meteorlogical Society. This study updates and refines hurricane damage normalization methodologies to provide a more accurate picture of how historical hurricanes would impact today\'s society.

Methodology Innovations

Our platform incorporates several methodological innovations over previously used cost normalization formulas:

' ) ``` Col {data-width=500} ---------------------------------------------- ### Storm Selector {data-height=500} ```{r} # Home - Storm Selector fluidRow( column(6, div( selectInput("stormBasin", "Basin", choices = "AL", width = "100%"), selectInput("stormYear", "Year", choices = loss_storms$storm_year, width = "100%"), selectInput("stormName", "Name", choices = NULL, width = "100%"), actionButton("selectStorm", "Submit", class = "btn-primary rounded", width = "100%") ) ), column(6, HTML('
Select a Storm
We are currently tracking 201 CONUS storms with over $3.6T in losses spanning from 1900 to 2024
Use the storm selector to the left or the table below to select a storm to analyze ') ) ) observeEvent(input$stormYear, { stormsByChosenYear <- loss_storms[loss_storms$storm_year == input$stormYear, ] stormsByYear <- loss_storms %>% filter(storm_year == input$stormYear) updateSelectInput(session, "stormName", choices = stormsByYear$storm_name, selected = NULL ) }) observeEvent(input$selectStorm, { storm_selection$storm_basin <- input$stormBasin storm_selection$storm_year <- input$stormYear storm_selection$storm_name <- input$stormName storm_selection$is_selected <- TRUE showNotification("Storm selection updated!", type = "message") }) ``` ### All Storms {data-height=500 .no-padding} ```{r} # Home - Storm Table output$normalized_storms_table <- renderDT({ datatable( latest_normalized_losses %>% select(-hurdatId), rownames = F, colnames = c("Storm", "Year", "MMH24", "MMP24"), selection = "single", options = list( pageLength = 1000, order = list(2, 'desc'), searching = F, paging = F, info = F, lengthChange = F, server = T ) ) %>% formatCurrency(c("mmh", "mmp"), "$", digits = 0) }) DTOutput("normalized_storms_table") ``` Storm Overview {data-navmenu="Storm Details"} ==================================== ```{r} # Storm Overview - Setup observe({ req(storm_selection$is_selected) 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] ) }) ``` Col {data-width=500} ------------------------------------ ### Track Map {.no-padding} ```{r} # Overview - Track Map # TODO: implement hurricane category status storm_track <- reactive({ req(storm_selection, storm_selection$is_selected) 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", options = providerTileOptions(updateWhenIdle = T)) %>% 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) }) leafletOutput("track_map", height = "100%") ``` Col {data-width=500 .tabset} ------------------------------------ ### Normalization and Landfalls {} ```{r} # Overview - Normalization and Landfalls storm_yearly_normalization <- reactive({ req(storm_selection$is_selected) 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) %>% dyRangeSelector() }) output$landfalls_table <- renderDT({ req(storm_selection$is_selected) hurdat_landfalls <- get_hurdat_landfalls(storm_selection) datatable( hurdat_landfalls, rownames = F, colnames = c("Date", "Longitude", "Latitude", "RMW", "Pressure", "Windspeed"), options = list( order = list(0, 'asc'), paging = F, searching = F, info = F, lengthChange = F, server = T ) ) %>% formatDate(columns = "datetime", method = "toUTCString") }) fillCol( flex = c(0.7, 0.3), div( fluidRow( style = "height: 100%", column(3, virtualSelectInput("storm_overview_cost_index_lf_select", "Landfalls", choices = NULL, showValueAsTags = T, multiple = T, autoSelectFirstOption = T), radioGroupButtons("storm_overview_cost_index_scale", label = "Value", choices = c("Index", "Loss"), status = "outline-primary rounded-0", justified = T), checkboxGroupButtons("storm_overview_cost_index_mmh_mmp", label = "MMH/MMP", choices = c("MMH", "MMP"), selected = c("MMH", "MMP"), status = "outline-primary rounded-0", justified = T), radioGroupButtons("storm_overview_cost_index_y_scale", label = "Y-Axis Scale", choices = c("Linear", "Log"), status = "outline-primary rounded-0", justified = T) ), column(9, dygraphOutput("cost_index_chart") ) ) ), div( DTOutput("landfalls_table") ) ) ``` ### Track Data {.no-padding} ```{r} # Overview - Track Data output$track_data <- renderDT({ datatable( 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 ) ) }) DTOutput("track_data") ``` Growth Trends {data-navmenu="Storm Details"} ================================ Column {data-width=550 .tabset} ------------------------------- ### Growth Map {.no-padding} ```{r} # Growth - Growth Map # TODO: implement data loading observe({ req(storm_selection$is_selected) updateSliderInput(session, "growth_trend_map_slider", min = storm_selection$storm_year, value = storm_selection$storm_year) }) test_storm <- reactiveValues( storm_basin = "AL", storm_year = 1926, storm_name = "GREAT MIAMI", ) test_counties <- reactive({ req(storm_selection$is_selected) counties <- get_normalized_metric_growth(test_storm, "LF1") 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$pop_growth_map <- renderLeaflet({ leaflet() %>% addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) %>% setView(lng = -81.3, lat = 25.6, zoom = 7) }) output$housing_growth_map <- renderLeaflet({ leaflet() %>% addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) %>% setView(lng = -81.3, lat = 25.6, zoom = 7) }) observe({ req(test_counties) leafletProxy("pop_growth_map", data = test_counties()) %>% clearShapes() %>% addPolygons( fillColor = "red", color = "red", fillOpacity = ~population_opacity, weight = 2 ) leafletProxy("housing_growth_map", data = test_counties()) %>% clearShapes() %>% addPolygons( fillColor = "blue", color = "blue", fillOpacity = ~housing_opacity, weight = 2 ) }) fillCol( flex = c(.1, .45, .45), div( style = " padding-left: 15px; padding-right: 15px; padding-top: 15px; display: flex; justify-content: center; align-itmes: center; ", sliderInput("growth_trend_map_slider", label = NULL, min = 1926, max = 2024, step = 1, animate = T, value = 1926, sep = "", width = "100%", ticks = F) ), leafletOutput("pop_growth_map", height = "100%"), leafletOutput("housing_growth_map", height = "100%") ) ``` ### Growth Data {.no-padding} ```{r} # Growth - Growth Data ``` Column {data-width=450} ---------------------------------- ### Landfall Growth {data-height=550} ```{r} # Growth - Trend Chart # TODO: add chart and chart controls fillCol( flex = c(.2, .8), fluidRow( column(6, selectInput("growth_trend_lf_select", "Landfall Select", choices = NULL) ), column(6, ) ), dygraphOutput("test_dy") ) output$test_dy <- renderDygraph({ test_ts <- test_query() dygraph(test_ts, main = "Normalized Aggregate Growth") %>% dySeries("population_index", label = "Population") %>% dySeries("housing_index", label = "Housing Units") %>% dyRangeSelector() }) #output$popHu <- renderDygraph({ # dygraph(aggregate_normalized_growth_metrics_lf_ts(), main = "Normalized Aggregate Growth") %>% # dySeries("normalized_population", label = "Population") %>% # dySeries("normalized_housing_units", label = "Housing Units") %>% # dyRangeSelector() #3}) ``` ### County Data {data-height=450 .no-padding} ```{r} # Growth - County Table great_miami_data <- data.frame( county_name = c("Broward County", "Collier County", "Miami-Dade County", "Monroe County"), housing_1926 = c(3.7, 0, 25, 3.5), housing_2024 = c(869, 250, 1100, 55), population_1926 = c(14, 0, 103, 16), population_2024 = c(2100, 428, 2990, 81) ) output$great_miami_dt <- renderDT({ datatable( great_miami_data, rownames = F, options = list( order = list(0, 'asc'), paging = F, searching = F, info = F, lengthChange = F, server = T ), colnames = c( "County", "1926 HU", "2024 HU", "1926 POP", "2024 POP" ), ) %>% # Format housing columns with blue background formatStyle( columns = c("housing_1926", "housing_2024"), backgroundColor = "rgba(0, 0, 255, 0.2)" ) %>% # Format population columns with red background formatStyle( columns = c("population_1926", "population_2024"), backgroundColor = "rgba(255, 0, 0, 0.2)" ) %>% formatCurrency( columns = c("housing_1926", "housing_2024", "population_1926", "population_2024"), currency = "k", digits = 0, before = F ) }) DTOutput("great_miami_dt") ``` Storm Fatalities {data-navmenu="Storm Details"} === ### {} ```{r} # TODO: add storm specific fatalities ``` Normalization Calculator {data-navmenu="Compute"} === Column {data-width=700 .tabset} --- ### Impact Map {.no-padding} ```{r} # Calculator - Impact Map output$impact_analysis_map <- renderLeaflet({ leaflet() %>% addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) %>% setView(lng = -80.3, lat = 25.6, zoom = 10) %>% addCircles( lng = -80.3, lat = 25.6, radius = 37040, color = "blue", weight = 2, opacity = 0.3 ) %>% addCircleMarkers( lng = -80.3, lat = 25.6, radius = 5, weight = 0, color = "blue", fillColor = "blue", fillOpacity = 0.6 ) }) leafletOutput("impact_analysis_map", height = "100%") ``` ### Impact Data {.no-padding} ```{r} # Calculator - Impact Data ``` Column {data-width=300} --- ### {} ```{r} # Calculator - Input # TODO: add data population and compute div( h6("Storm Selector"), selectInput("impact_storm_basin", label = NULL, choices = "AL", width = "100%"), selectInput("impact_storm_year", label = NULL, choices = 1926, width = "100%"), selectInput("impact_storm_name", label = NULL, choices = "GREAT MIAMI", width = "100%"), fluidRow( column(6, selectInput("impact_storm_lf_type", label = NULL, choices = "LF", width = "100%") ), column(6, selectInput("impact_storm_lf_id", label = NULL, choices = "1", width = "100%") ) ), actionButton("impact_populate_storm", label = "Populate", width = "100%", class = "btn-primary rounded") ) hr() div( fluidRow( column(6, textInput("impact_lat", placeholder = "Lat", value = "25.6", label = "Latitude", width = "100%") ), column(6, textInput("impact_lon", placeholder = "Lon", value = "-80.3", label = "Longitude", width = "100%") ) ), fluidRow( column(4, textInput("impact_rmw", placeholder = "RMW", value = "20", label = "RMW (NM)", width = "100%") ), column(8, sliderInput("impact_rmw_slider", label = NULL, min = 1, max = 150, value = 20, ticks = F, width = "100%") ) ), radioGroupButtons("impact_rmw_multiplier", label = "RMW Multiplier", choices = c("1x", "2x", "3x"), status = "outline-primary rounded-0", justified = T), fluidRow( column(6, textInput("impact_base_year", placeholder = "Impact Year", value = "1926", label = "Base Year", width = "100%") ), column(6, textInput("impact_ref_year", placeholder = "Reference Year", value = "2024", label = "Ref Year", width = "100%") ) ), textInput("impact_base_damage", placeholder = "Storm Base Damage", label = "Base Damage", value = "76,000,000", width = "100%"), actionButton("impact_calculate", label = "Calculate", width = "100%", class = "btn-primary rounded") ) ``` Data Export {data-navmenu="Compute"} === ```{r} # Export - Mock Data datasets_info <- data.frame( id = c("hurricane_costs", "population_housing", "fatalities", "storm_tracks", "affected_areas", "economic_data"), name = c("Hurricane Cost Normalization", "Population & Housing", "Storm Fatalities", "Hurricane Best Track", "Affected Areas", "Yearly Economics"), description = c( "Normalized economic damage estimates for US landfalling hurricanes 1900-2023 using updated RMW methodology", "County-level population and housing unit data used for normalization calculations", "Direct and indirect fatalities from hurricane impacts by location and storm", "Best track data including storm positions, intensities, and wind radii from HURDAT2", "Geographic areas impacted by hurricane landfalls with RMW coverage percentages", "Yearly economic data used in normalization calculations" ), size = c("~200 storms", "3,000+ counties", "150+ storms", "2,000+ storms", "5,000+ records", "100+ years"), last_updated = c("2024-12-01", "2024-11-15", "2024-10-30", "2024-12-15", "2024-11-30", "2025-01-01"), tables = c("econ.normalized_landfalls, econ.storm_base_loss", "metrics.pop_and_housing", "fatal.storm_total_fatalities, fatal.storm_fatalities_type", "hurdat.best_track, hurdat.hurdat_storms", "gis.affected_area_landfalls", "econ.usa_yearly"), stringsAsFactors = FALSE ) # Reactive values to store selected datasets values <- reactiveValues(selected_datasets = character(0)) ``` Column {data-width=600} ------------------------------------- ### Available Datasets ```{r} # Export - Datasets create_dataset_card <- function(dataset_row) { card_id <- paste0("card_", dataset_row$id) div( class = "dataset-card", id = card_id, style = "border: 2px solid #e3e3e3; border-radius: 8px; padding: 15px; margin: 10px 0; cursor: pointer; transition: all 0.3s ease;", div( style = "display: flex; justify-content: space-between; align-items: flex-start;", # Left content div( style = "flex: 1;", tags$b(dataset_row$name, style = "font-size: 16px; margin: 0 0 8px 0; color: #2c3e50; display: block;"), p(dataset_row$description, style = "margin: 0 0 10px 0; color: #5a6c7d; font-size: 14px; line-height: 1.4;"), # Metadata row div( style = "display: flex; gap: 20px; flex-wrap: wrap;", span(icon("database"), strong("Size: "), dataset_row$size, style = "color: #7f8c8d; font-size: 12px;"), span(icon("calendar"), strong("Updated: "), dataset_row$last_updated, style = "color: #7f8c8d; font-size: 12px;"), span(icon("table"), strong("Tables: "), dataset_row$tables, style = "color: #7f8c8d; font-size: 11px;") ) ), # Selection checkbox div( style = "margin-left: 15px;", checkboxInput( inputId = paste0("select_", dataset_row$id), label = NULL, value = FALSE, width = "20px" ) ) ) ) } # Update selected datasets based on checkboxes observe({ selected <- character(0) for(i in 1:nrow(datasets_info)) { dataset_id <- datasets_info[i, "id"] if(isTruthy(input[[paste0("select_", dataset_id)]])) { selected <- c(selected, dataset_id) } } values$selected_datasets <- selected }) # Add JavaScript for card click interaction tags$script(HTML(" $(document).on('click', '.dataset-card', function() { var checkbox = $(this).find('input[type=\"checkbox\"]'); checkbox.prop('checked', !checkbox.prop('checked')).trigger('change'); if(checkbox.prop('checked')) { $(this).addClass('selected'); } else { $(this).removeClass('selected'); } }); ")) # Instructions div( style = "margin-bottom: 20px; padding: 15px; background-color: #f0f8ff; border-radius: 0; border-left: 4px solid #3498db;", p(strong("Instructions:"), "Select datasets from the cards below by clicking on them. Your selected datasets will appear in the export panel on the right.", style = "margin: 0; color: #2c3e50;") ) # Render dataset cards output$dataset_cards <- renderUI({ cards <- lapply(1:nrow(datasets_info), function(i) { create_dataset_card(datasets_info[i, ]) }) do.call(tagList, cards) }) uiOutput("dataset_cards") ``` Column {data-width=400} ------------------------------------- ### Data Export {data-height=600} ```{r} # Export - Download div( class = "export-box", tags$b("Export Selected Data", style = "font-size: 18px; margin-top: 0; color: #2c3e50; display: block; margin-bottom: 15px;"), # Selected datasets display tags$b("Selected Datasets:", style = "font-size: 14px; margin-bottom: 10px; color: #34495e; display: block;"), div( id = "selected-datasets-display", style = "min-height: 60px; margin-bottom: 20px; padding: 10px; background-color: white; border-radius: 4px; border: 1px solid #ddd;", uiOutput("selected_datasets_display") ), # Format selection tags$b("Export Format:", style = "font-size: 14px; margin-bottom: 10px; color: #34495e; display: block;"), radioButtons( "export_format", label = NULL, choices = list( "CSV (Comma Separated)" = "csv", "JSON" = "json" ), selected = "csv", inline = FALSE ), # Export options checkboxInput( "include_documentation", "Include documentation", value = TRUE ), # Export button br(), downloadButton( "download_data", "Export Selected Data", class = "btn-primary", style = "" ) ) # Display selected datasets output$selected_datasets_display <- renderUI({ if(length(values$selected_datasets) == 0) { p("No datasets selected", style = "color: #95a5a6; font-style: italic; margin: 20px 0;") } else { selected_names <- datasets_info$name[datasets_info$id %in% values$selected_datasets] lapply(selected_names, function(name) { span( class = "selected-item", icon("check-circle"), " ", name ) }) } }) ``` ### Contact {data-height=400} ```{r} # Export - Contact div( class = "info-box", tags$b("Need More Data?", style = "font-size: 16px; margin-top: 0; color: #2c3e50; display: block; margin-bottom: 10px;"), p("Additional datasets, custom queries, and research collaborations are available through our team.", style = "margin-bottom: 15px; color: #5a6c7d; font-size: 14px;"), p(icon("envelope"), strong(" Email:"), " [CONTACT US EMAIL]", style = "margin: 5px 0; color: #34495e; font-size: 14px;") ) ``` Tracked Storms {data-navmenu="All Storms"} === Column {data-width=650} --- ### {} ```{r} # Tracking - Storms Table #DT with storm, hurdatid, base damage, mmh, mmp, maybe multipliers?, sparkline? output$normalized_storms_full_table <- renderDT({ datatable( latest_normalized_losses, rownames = F, colnames = c("HURDAT Code", "Storm", "Year", "MMH24", "MMP24"), selection = "none", options = list( pageLength = 20, order = list(0, 'asc'), server = T ) ) %>% formatCurrency(c("mmh", "mmp"), "$", digits = 0) }) DTOutput("normalized_storms_full_table") ``` Column {data-width=350} --- ### {.no-padding} ```{r} # Tracking - Storms Map output$all_storms_map <- renderLeaflet({ leaflet() %>% addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) %>% 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 ) }) leafletOutput("all_storms_map", height = "100%") ``` Fatalities {data-navmenu="All Storms"} === ### {data-height=500} ```{r eval=FALSE, include=FALSE} fatality_years <- seq(1900, 2010, by = 10) direct_deaths <- c(6000, 275, 0, 408, 26, 654, 466, 213, 104, 228, 1136, 321) indirect_deaths <- c(0, 0, 0, 0, 0, 1, 8, 15, 40, 54, 1171, 368) yearly_fatalities <- data.frame(fatality_years, direct_deaths, indirect_deaths) %>% mutate( fatality_years = as.Date(paste0(fatality_years, "-01-01")) ) yearly_fatalities_ts <- yearly_fatalities %>% select(-fatality_years) %>% xts(order.by = yearly_fatalities$fatality_years) output$decade_fatalities <- renderDygraph( dygraph(yearly_fatalities_ts, main = "Fatalities By Decade") %>% dySeries("direct_deaths", label = "Direct Deaths") %>% dySeries("indirect_deaths", label = "Indirect Deaths") %>% dyRangeSelector() ) dygraphOutput("decade_fatalities") ``` ### {data-height=500} ```{r eval=FALSE, include=FALSE} surge_yearly <- c(0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 410, 107) surf_yearly <- c(0, 0, 0, 0, 0, 0, 0, 14, 2, 12, 12, 17) rough_seas_yearly <- c(0, 0, 0, 0, 16, 0, 2, 0, 24, 17, 0, 14) rip_current_yearly <- c(0, 0, 0, 0, 0, 0, 0, 0, 0, 6, 14, 3) freshwater_floods_yearly <- c(0, 0, 0, 0, 0, 200, 12, 151, 0, 117, 50, 284) wind_yearly <- c(0, 0, 0, 0, 0, 0, 0, 8, 14, 23, 11, 82) tree_fall_yearly <- c(0, 0, 0, 0, 1, 0, 0, 1, 0, 9, 24, 56) tornado_yearly <- c(0, 0, 0, 0, 1, 12, 43, 7, 0, 7, 11, 7) traffic_yearly <- c(0, 0, 0, 0, 0, 0, 0, 4, 0, 3, 2, 1) traffic_accident_yearly <- c(0, 0, 0, 0, 0, 0, 5, 0, 0, 8, 26, 11) electrocution_yearly <- c(0, 0, 0, 0, 0, 0, 2, 0, 0, 5, 2, 7) other_yearly <- c(0, 0, 0, 0, 5, 0, 5, 11, 15, 13, 37, 7) yearly_fatalities_type <- data.frame(fatality_years, surge_yearly, surf_yearly, rough_seas_yearly, rip_current_yearly, freshwater_floods_yearly, wind_yearly, tree_fall_yearly, tornado_yearly, traffic_yearly, traffic_accident_yearly, electrocution_yearly, other_yearly) %>% mutate( fatality_years = as.Date(paste0(fatality_years, "-01-01")) ) yearly_fatalities_type_ts <- yearly_fatalities_type %>% select(-fatality_years) %>% xts(order.by = yearly_fatalities_type$fatality_years) output$decade_fatalities_type <- renderDygraph( dygraph(yearly_fatalities_type_ts, main = "Fatality Types By Decade") %>% dySeries("surge_yearly", label = "Surge") %>% dySeries("surf_yearly", label = "Surf") %>% dySeries("rough_seas_yearly", label = "Rough Seas") %>% dySeries("rip_current_yearly", label = "Rip Current") %>% dySeries("freshwater_floods_yearly", label = "Freshwater Floods") %>% dySeries("wind_yearly", label = "Wind") %>% dySeries("tree_fall_yearly", label = "Tree Fall") %>% dySeries("tornado_yearly", label = "Tornado") %>% dySeries("traffic_yearly", label = "Traffic") %>% dySeries("traffic_accident_yearly", label = "Traffic Accident") %>% dySeries("electrocution_yearly", label = "Electrocution") %>% dySeries("other_yearly", label = "Other") %>% dyRangeSelector() ) dygraphOutput("decade_fatalities_type") ``` ### {data-height=500} ```{r eval=FALSE, include=FALSE} fatality_type <- c("Surge", "Surf", "Rough Seas", "Rip Current", "Floods", "Wind", "Tree Fall", "Tornado", "Traffic", "Traffic Accident", "Electrocution", "Other") fatality_totals <- c(520, 56, 77, 23, 826, 131, 91, 88, 10, 45, 16, 56) aggregate_fatality_types <- data.frame(fatality_type, fatality_totals) output$aggregate_fatalities <- renderBillboarder( billboarder() %>% bb_piechart(aggregate_fatality_types) #%>% bb_legend(position = "right") ) billboarderOutput("aggregate_fatalities") ``` ### {data-height=500} ```{r eval=FALSE, include=FALSE} ``` Column {data-width=500 .tabset} --- ### Fatality Map {} ```{r} ``` ### Fatality Geo Data {} ```{r} ``` Column {data-width=500} --- ### Perils {data-height=500} ```{r} ``` ### Trends {data-height} ```{r} ``` About ===