Our platform provides access to normalized hurricane dama data spanning from 1900 to 2024, allowing researchers, policymakers, insurance professional, and the public to better understand how hurricane costs have changed over time.
The core datasets used in this app are based on research by Muller et al. (2025) and the expanded analysis by Mooney et al. (2025), published in the Bulletin of the American Meteorlogical Society and ****JOURNAL**** respectively. These studies update and refine hurricane damage normalization methodologies to provide a more accurate picture of how historical hurricanes would impact today\'s society.
Our platform incoroprates several methodological innovations over previously used cost normalization formulas:
CONTACT INFO?
' ) ``` ```{r} HTML( 'Our platform provides access to normalized hurricane dama data spanning from 1900 to 2024, allowing researchers, policymakers, insurance professional, and the public to better understand how hurricane costs have changed over time.
The core datasets used in this app are based on research by Muller et al. (2025) published in the 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.
Our platform incoroprates several methodological innovations over previously used cost normalization formulas:
CONTACT INFO?
' ) ``` Col {data-width=500} ---------------------------------------------- ### Storm Selector {data-height=500} ```{r} fluidRow( column(6, selectInput("stormBasin", "Select Basin", choices = "AL"), selectInput("stormYear", "Select Year", choices = loss_storms$storm_year), selectInput("stormName", "Select Storm", choices = NULL), actionButton("selectStorm", "Submit", class = "btn-primary") ), column(6, #TODO: ADD TABLE #DTOutput("storm_selector_table") ) ) 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} output$normalized_storms_table <- renderDT({ datatable( normalized_losses_2024 %>% select(Storm = storm_name, Year = storm_year, MMH24 = mmh, MMP24 = mmp), rownames = F, selection = "single", options = list( pageLength = 1000, order = list(2, 'desc'), searching = F, paging = F, info = F, lengthChange = F, server = T ) ) %>% formatCurrency(c("MMH24", "MMP24"), "$", digits = 0) }) DTOutput("normalized_storms_table") ``` Storm Overview {data-navmenu="Storm Details"} ==================================== ```{r} ### REACTIVE VALUES FOR STORM OVERVIEW storm_overview_reactive <- reactiveValues( lf_type = NULL, lf_id = NULL, full_lf_id = NULL, use_normalized_costs = FALSE ) ``` Col {data-width=500} ------------------------------------ ### Storm Details {data-height=200} ```{r} # TODO: add storm details section: name, base loss, base loss source, etc. HTML(' ') ``` ### Normalization Cost Index {data-height=800} ```{r} storm_unique_landfalls <- reactive({ req(storm_selection$is_selected) result <- econ.storm_base_loss %>% filter( storm_basin == storm_selection$storm_basin, storm_year == storm_selection$storm_year, storm_name == storm_selection$storm_name ) %>% mutate( full_lf_id = paste0(lf_type, lf_id) ) %>% distinct( full_lf_id, .keep_all = T ) %>% arrange( full_lf_id ) %>% select( storm_basin, storm_year, storm_name, lf_type, lf_id, full_lf_id ) %>% collect() return(result) }) storm_normalized_landfall <- reactive({ req(storm_overview_reactive$full_lf_id) result <- econ.normalized_landfalls %>% filter( storm_basin == storm_selection$storm_basin, storm_year == storm_selection$storm_year, storm_name == storm_selection$storm_name, lf_type == storm_overview_reactive$lf_type, lf_id == storm_overview_reactive$lf_id ) %>% left_join(econ.storm_base_loss %>% filter(!is.na(base_loss)) %>% mutate( ncei_priority = case_when( str_like(base_loss_source, "%ncei%") ~ 1, str_like(base_loss_source, "%ncei%") ~ 2, TRUE ~ 3 ) ) %>% group_by(storm_basin, storm_year, storm_name, lf_type, lf_id) %>% slice_min(ncei_priority, n = 1, with_ties = F) %>% ungroup(), by = c("storm_basin", "storm_year", "storm_name", "lf_type", "lf_id")) %>% mutate( mmh_index = (gdp_deflator * rwhu * affected_housing), mmp_index = (gdp_deflator * rwpc * affected_population), mmh = (base_loss * mmh_index), mmp = (base_loss * mmp_index) ) %>% select( -base_loss_source, -base_loss, -base_loss_citation, -doi, -notes, -ncei_priority ) %>% collect() cat(str(result)) return(result) }) storm_cost_index_base_index_ts <- reactive({ req(storm_normalized_landfall()) cost_index <- storm_normalized_landfall() %>% select( normalization_year, mmh_index, mmp_index ) %>% mutate(normalization_year = as.Date(paste0(normalization_year, "-01-01"))) cost_index_ts <- cost_index %>% select(-normalization_year) %>% xts(order.by = cost_index$normalization_year) cat(str(cost_index_ts)) result <- cost_index_ts return(result) }) storm_cost_index_normalized_costs_ts <- reactive({ req(storm_normalized_landfall()) cost_index <- storm_normalized_landfall() %>% select( normalization_year, mmh, mmp ) %>% mutate(normalization_year = as.Date(paste0(normalization_year, "-01-01"))) cost_index_ts <- cost_index %>% select(-normalization_year) %>% xts(order.by = cost_index$normalization_year) cat(str(cost_index_ts)) result <- cost_index_ts return(result) }) observe({ req(storm_unique_landfalls()) storm_overview_reactive$lf_type = storm_unique_landfalls()$lf_type[1] storm_overview_reactive$lf_id = storm_unique_landfalls()$lf_id[1] storm_overview_reactive$full_lf_id = storm_unique_landfalls()$full_lf_id[1] }) observe({ req(storm_overview_reactive$full_lf_id) updateSelectInput( session, "storm_overview_cost_index_lf", choices = storm_unique_landfalls()$full_lf_id, selected = storm_overview_reactive$full_lf_id ) }) observeEvent(input$storm_overview_select_base, { # TODO: add button to select normalized costs }) output$costIndex <- renderDygraph({ req(storm_normalized_landfall()) if(storm_overview_reactive$use_normalized_costs == F) { dygraph(storm_cost_index_base_index_ts(), main = paste(storm_selection$storm_name, storm_selection$storm_year, "Cost Index")) %>% dySeries("mmh_index", label = "MMH Index") %>% dySeries("mmp_index", label = "MMP Index") %>% dyRangeSelector(height = 30) }else{ dygraph(storm_cost_index_normalized_costs_ts(), main = paste(storm_selection$storm_name, storm_selection$storm_year, "Cost Index")) %>% dySeries("mmh", label = "MMH") %>% dySeries("mmp", label = "MMP") %>% dyRangeSelector(height = 30) } }) fillCol( flex = c(.2, .8), fluidRow( column(4, selectInput("storm_overview_cost_index_lf", "Landfall Select", choices = NULL) ), column(4, # TODO: add button to select normalized costs #checkboxInput("storm_overview_select_base", "Include Normalized Losses", value = F) ), column(4, #checkboxInput("mmpSelect", "Display MMP", value = T) ) ), dygraphOutput("costIndex") ) ``` Col {data-width=500} ------------------------------------ ### Fatalities {data-height=200} ```{r} fluidRow( column(6, HTML('Surge: 387
') ), column(6, actionLink("fatalitiesLink", tagList(icon("arrow-right"), "Fatalities dashboard"), class = "btn btn-outline") ) ) ``` ### Landfalls {data-height=300 .no-padding} ```{r} storm_landfalls <- reactive({ req(storm_selection$is_selected) result <- hurdat.best_track %>% filter( storm_basin == storm_selection$storm_basin, storm_year == storm_selection$storm_year, storm_name == storm_selection$storm_name, record_identifier == "L" ) %>% mutate( lon = sql("ST_X(ST_Transform(location::geometry, 4326))"), lat = sql("ST_Y(ST_Transform(location::geometry, 4326))") ) %>% select( Date = datetime, Longitude = lon, Latitude = lat, RMW = rmw, Pressure = pressure, Windspeed = windspeed ) %>% collect() cat(str(result)) return(result) }) output$landfalls_table <- renderDT({ datatable( storm_landfalls(), rownames = F, options = list( order = list(0, 'asc'), paging = F, searching = F, info = F, lengthChange = F, server = T ) ) %>% formatDate(columns = "Date", method = "toUTCString") }) DTOutput("landfalls_table") ``` ### Storm Track {data-height=500 .no-padding} ```{r} storm_track <- reactive({ req(storm_selection$is_selected) result <- hurdat.best_track %>% filter( storm_basin == storm_selection$storm_basin, storm_year == storm_selection$storm_year, storm_name == storm_selection$storm_name ) %>% mutate( lon = sql("ST_X(ST_Transform(location::geometry, 4326))"), lat = sql("ST_Y(ST_Transform(location::geometry, 4326))"), rmw_meters = (rmw * 1852) ) %>% select( datetime, lon, lat, rmw, record_identifier, rmw_meters ) %>% collect() cat(str(result)) return(result) }) output$trackMap <- renderLeaflet({ leaflet() %>% addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) %>% setView(lng = -80, lat = 32, zoom = 4) %>% addPolylines( data = storm_track(), lng = ~lon, lat = ~lat, weight = 4, color = "blue" ) %>% addCircleMarkers( data = storm_track() %>% filter(record_identifier == "L"), lng = ~lon, lat = ~lat, radius = 5, weight = 0, color = "red", fillColor = "red", fillOpacity = 0.8 ) %>% addCircles( data = storm_track() %>% filter(record_identifier == "L"), lng = ~lon, lat = ~lat, radius = ~rmw_meters, weight = 2, color = "red", fillColor = "red", fillOpacity = 0.3 ) }) leafletOutput("trackMap", height="100%") ``` Growth Trends {data-navmenu="Storm Details"} ================================ Column {data-width=550} ------------------------------- ### {data-height=1000 .no-padding} ```{r} growth_trends <- reactiveValues( lf_id = NULL ) dbStormCounties <- reactive({ req(storm_selection$is_selected) sel_storm_basin <- storm_selection$storm_basin sel_storm_year <- storm_selection$storm_year sel_storm_name <- storm_selection$storm_name sel_lfid <- growth_trends$lf_id affectedCounties <- gis.affected_area_landfalls %>% mutate( fips = paste0(state_fips, county_fips), lfid = paste0(lf_type, lf_id) ) %>% filter( storm_basin == sel_storm_basin, storm_year == sel_storm_year, storm_name == sel_storm_name, lfid == sel_lfid ) %>% left_join( public.counties %>% mutate(geom_wkt = sql("ST_AsText(ST_Transform(geom, 4326))")) %>% rename(state_fips = statefp, county_fips = countyfp), by = c("state_fips", "county_fips") ) %>% collect() affectedCounties_sf <- affectedCounties %>% st_as_sf(wkt = "geom_wkt") cat(str(affectedCounties_sf)) return(affectedCounties_sf) }) output$popMapPoly <- renderLeaflet({ leaflet(dbStormCounties()) %>% addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) %>% setView(lng = -89.8, lat = 29.6, zoom = 8) %>% addPolygons( fillColor = "red", fillOpacity = 0.3, color = "black", weight = 2 ) }) output$housingMapPoly <- renderLeaflet({ leaflet() %>% addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) %>% setView(lng = -89.8, lat = 29.6, zoom = 8) %>% addPolygons( data = dbStormCounties(), fillColor = "blue", fillOpacity = 0.3, color = "black", weight = 2 ) }) fillCol( flex = c(1, 1), leafletOutput("popMapPoly"), leafletOutput("housingMapPoly") ) ``` Column {data-width=450} ---------------------------------- ### Landfall Selection {data-height=150} ```{r} fluidRow( column(4, selectInput("growthTrendLfSelect", "Landfall", choices = NULL) ), column(4, ), column(4, ) ) observeEvent(input$growthTrendLfSelect, { growth_trends$lf_id = input$growthTrendLfSelect showNotification("Landfall updated", type = "message") }) ``` ### Time Series {data-height=400 .no-padding} ```{r} katrinaLfTwoLong <- katrinaLfTwoCountyMetrics %>% pivot_longer( cols = -c(fips, metric), names_to = "year", values_to = "value" ) %>% group_by( metric, year ) %>% summarize( aggregateValue = sum(value, na.rm = T), .groups = "drop" ) %>% pivot_wider( names_from = metric, values_from = aggregateValue ) normalizedKatrinaLfTwo <- xlallLandfallsNormalized %>% filter(hurdatId == "AL122005" & lfId == "LF2") %>% select(normalizationYear, affectedPop, affectedHousing) normalizedKatrinaLfTwoTs <- normalizedKatrinaLfTwo %>% select(-normalizationYear) %>% as.matrix() %>% xts(order.by = as.Date(paste0(normalizedKatrinaLfTwo$normalizationYear, "-01-01"))) katrinaLfTwoLongTs <- katrinaLfTwoLong %>% select(-year) %>% as.matrix() %>% xts(order.by = as.Date(paste0(katrinaLfTwoLong$year, "-01-01"))) output$popHu <- renderDygraph({ dygraph(normalizedKatrinaLfTwoTs, main = "Normalized LF2 Aggregate Growth") %>% dySeries("affectedPop", label = "Population") %>% dySeries("affectedHousing", label = "Housing Units") %>% dyRangeSelector() }) #dygraphOutput("popHu") ``` ### County Data {data-height=450 .no-padding} ```{r} output$katrinaCounties <- renderDT({ datatable( katrinaLfTwoCountyMetrics, rownames = F, #extensions = "RowGroup", options = list( pageLength = 1000, #rowGroup = list(dataSrc = 1), paging = F, searching = F, info = F, lengthChange = F, server = T ) ) }) #DTOutput("katrinaCounties") ``` Fatalities {data-navmenu="Fatalities"} === Column {data-width=500} --- ### {data-height=500} ### {data-height=500} Column {data-width=500} --- ### {data-height=500} ```{r} ``` ### {data-height=500} ```{r} ``` Storm Comparison {data-navmenu="Compute"} === Sandbox {data-navmenu="Compute"} === Data {data-navmenu="Compute"} === Top 50 Storms === ```{r} #DT with storm, hurdatid, base damage, mmh, mmp, maybe multipliers?, sparkline? ``` About ===