--- title: "Hurricane Normalization App" runtime: shiny output: flexdashboard::flex_dashboard: orientation: columns vertical_layout: fill theme: version: 4 bootswatch: litera --- ```{r setup, 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) linuxdir <- "/home/dylan/Personal/Projects/Hurricane Normalization/" macdir <- "~/Desktop/Personal/Projects/Hurricane Normalization/" #baseDir <- macdir baseDir <- linuxdir config <- config::get(file = paste0(baseDir, "R/dataScripts/restructured/app/config.yml")) # SUPABASE CON con <- dbConnect( RPostgres::Postgres(), host = config$db_host, port = config$db_port, dbname = config$db_dbname, user = config$db_user, password = config$db_password ) selected_storm_name <- "KATRINA" selected_storm_year <- 2005 selected_storm_basin <- "AL" selected_lf_type = "LF" selected_lf_id = "2" xlallLandfallsNormalized <- read.csv(paste0(baseDir, "R/dataScripts/restructured/normalization/all-landfalls-normalized.csv"), header = T) %>% select(-X) normalized2024 <- read.csv(paste0(baseDir, "R/dataScripts/restructured/normalization/2024-normalized.csv"), header = T) %>% select(-X, -hurdatId, -MMH23, -MMP23) %>% filter(MMH24 > 0) %>% mutate( lf_date = trimws(lf_date) ) normalized2024 <- normalized2024 %>% mutate( lf_date = mdy(lf_date) ) %>% rename( Storm = storm_name, Landfall = lf_date ) pop <- read.csv(paste0(baseDir, "Data/population_with_projections.csv"), stringsAsFactors = F) %>% pivot_longer( cols = starts_with("X"), names_to = "year", values_to = "pop", ) %>% rename(population = pop) %>% mutate( year = parse_number(year), FIPS = ifelse(nchar(FIPS) == 4, paste0("0", FIPS), FIPS), state_fips = substr(FIPS, 1, 2), county_fips = substr(FIPS, 3, 5) ) %>% select(!full_county_and_state:County & !county_state & !FIPS) housing <- read.csv(paste0(baseDir, "Data/housing_units.csv"), stringsAsFactors = F) %>% pivot_longer( cols = starts_with("X"), names_to = "year", values_to = "housing" ) %>% mutate( year = parse_number(year), FIPS = ifelse(nchar(FIPS) == 4, paste0("0", FIPS), FIPS), state_fips = substr(FIPS, 1, 2), county_fips = substr(FIPS, 3, 5) ) %>% rename(housing_units = housing) %>% select(!County.Full:County & !County.State & !FIPS) metrics.pop_and_housing <- pop %>% left_join(housing, by = c("state_fips", "county_fips", "year")) weightedCounties <- read.csv(paste0(baseDir, "R/dataScripts/weighted-counties.csv"), header = T) %>% mutate( weight = (PERCENTAGE/100), FIPS = ifelse(nchar(FIPS) == 4, paste0("0", FIPS), FIPS), state_fips = substr(FIPS, 1, 2), county_fips = substr(FIPS, 3, 5) ) %>% select( state_fips, county_fips, hurdatId = HURDAT_Cod, storm_name = Name_1, lfId = LF_ID_Mull, lf_date = LF_Date, year = Year, rmw = RMW, lat = Lat, lon = Long, rmw_2x = RMW_x2, area = AREA, weight ) katrinaAffectedCounties <- weightedCounties %>% filter(hurdatId == "AL122005" & lfId == "LF2") %>% mutate( fips = paste0(state_fips, county_fips) ) katrinaLfTwoCountyMetrics <- metrics.pop_and_housing %>% filter(year >= 2005) %>% pivot_longer( cols = c("population", "housing_units"), names_to = "metric", values_to = "value" ) %>% pivot_wider( names_from = year, values_from = value, ) %>% mutate( fips = paste0(state_fips, county_fips) ) %>% filter(fips %in% katrinaAffectedCounties$fips) %>% select(fips, !state_fips & !county_fips) ###### REACTIVE VALUES storm_selection <- reactiveValues( storm_year = NULL, storm_name = NULL, storm_basin = NULL, lf_id = NULL, is_selected = FALSE ) ###### # LAZY LOAD DB TABLES econ.normalized_landfalls <- tbl(con, I("econ.normalized_landfalls")) econ.storm_base_loss <- tbl(con, I("econ.storm_base_loss")) econ.usa_yearly <- tbl(con, I("econ.usa_yearly")) fatal.storm_fatalities_type <- tbl(con, I("fatal.storm_fatalities_type")) fatal.storm_total_fatalities <- tbl(con, I("fatal.storm_total_fatalities")) fips.counties <- tbl(con, I("fips.counties")) fips.states <- tbl(con, I("fips.states")) gis.affected_area_landfalls <- tbl(con, I("gis.affected_area_landfalls")) hurdat.best_track <- tbl(con, I("hurdat.best_track")) hurdat.hurdat_storms <- tbl(con, I("hurdat.hurdat_storms")) metrics.geo_attributes <- tbl(con, I("metrics.geo_attributes")) #metrics.pop_and_housing <- tbl(con, I("metrics.pop_and_housing")) public.counties <- tbl(con, I("public.counties")) ### COMMONLY USED DATA loss_storms <- econ.storm_base_loss %>% select( storm_basin, storm_year, storm_name ) %>% distinct( storm_basin, storm_year, storm_name ) %>% left_join( hurdat.hurdat_storms %>% mutate(hurdatId = paste0(storm_basin, storm_number, storm_year)), by = c("storm_basin", "storm_year", "storm_name")) %>% select( hurdatId, storm_name, storm_year ) %>% collect() base_losses_by_lf <- 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() %>% collect() total_base_losses <- base_losses_by_lf %>% group_by(storm_basin, storm_year, storm_name) %>% summarize( total_base_loss = sum(base_loss), .groups = "drop" ) %>% collect() normalized_losses_2024 <- econ.normalized_landfalls %>% filter(normalization_year == 2024) %>% 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_lf = (base_loss * gdp_deflator * rwhu * affected_housing), mmp_lf = (base_loss * gdp_deflator * rwpc * affected_population) ) %>% group_by(storm_basin, storm_year, storm_name) %>% summarize( mmh = sum(mmh_lf, na.rm = T), mmp = sum(mmp_lf, na.rm = T), .groups = "drop" ) %>% filter(!is.na(mmh) & !is.na(mmp)) %>% collect() ``` ```{r} ###### REACTIVE SETUP #REACTIVES USE LAZY LOADING #hurdat.best_track <- dbGetQuery(con, "SELECT *, ST_X(ST_Transform(location::geometry, 4326)) as lon, ST_Y(ST_Transform(location::geometry, 4326)) as lat FROM hurdat.best_track") selected.best_track <- reactive({ req(storm_selection$is_selected) query <- paste0(" SELECT *, ST_X(ST_Transform(location::geometry, 4326)) as lon, ST_Y(ST_Transform(location::geometry, 4326)) as lat FROM hurdat.best_track WHERE storm_basin = '", storm_selection$storm_basin, "' AND storm_year = ", storm_selection$storm_year, " AND storm_name = '", storm_selection$storm_name, "'") result <- dbGetQuery(con, query) cat(paste0("DEBUG: selected.best_track returned ", nrow(result))) return(result) }) ``` Home ============================================= Col {data-width=500} ---------------------------------------------- ### {} ```{r eval=FALSE, include=FALSE} HTML( '

Welcome to the Hurricane Cost Normalization Web App!

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.

Our Data

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.

Methodology Innovations

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

Questions?

CONTACT INFO?

' ) ``` ```{r} HTML( '

Welcome to the Hurricane Cost Normalization Web App!

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.

Our Data

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.

Methodology Innovations

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

Questions?

CONTACT INFO?

' ) ``` Col {data-width=500} ---------------------------------------------- ### Storm Selector {data-height=500} ```{r} fluidRow( column(6, h5("Select Storm Name and Year"), 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") ) ) output$storm_selector_table <- renderDT({ datatable( loss_storms, rownames = F, options = list( pageLength = 1000, order = list(2, 'desc'), searching = F, paging = F, info = F, lengthChange = F, server = T ) ) }) observeEvent(input$stormYear, { stormsByChosenYear <- loss_storms[loss_storms$storm_year == input$stormYear, ] updateSelectInput(session, "stormName", choices = stormsByChosenYear$storm_name, selected = NULL) }) observeEvent(input$selectStorm, { storm_selection$storm_year <- input$stormYear storm_selection$storm_name <- input$stormName storm_selection$storm_basin <- "AL" storm_selection$is_selected <- TRUE showNotification("Storm selection updated!", type = "message") }) ``` ### All Storms {data-height=500 .no-padding} ```{r} output$allStorms <- renderDT({ datatable( normalized_losses_2024 %>% select(Storm = storm_name, Year = storm_year, MMH24 = mmh, MMP24 = mmp), rownames = F, 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("allStorms") ``` Storm Overview {data-navmenu="Storm Details"} ==================================== Col {data-width=500} ------------------------------------ ### Storm Details {data-height=200} ```{r} HTML('
Katrina

Hurricane Katrina was a powerful, devestating and historic tropical cyclone that caused 1,392 fatalities and damages estimated at $125 billion in late August 2005.

') ``` ### Normalization Cost Index {data-height=800} ```{r} ##BY LANDFALL### ##MULTIPLE LINES### dbNormalizedLandfalls <- reactive({ req(storm_selection$is_selected) query <- paste0(" SELECT *, CONCAT(lf_type, lf_id) as lfid FROM econ.normalized_landfalls WHERE storm_basin = '", storm_selection$storm_basin, "' AND storm_year = ", storm_selection$storm_year, " AND storm_name = '", storm_selection$storm_name, "'") result <- dbGetQuery(con, query) #cat(str(result)) showNotification(nrow(result)) return(result) }) dbUniq <- reactive({ req(dbNormalizedLandfalls(), nrow(dbNormalizedLandfalls()) > 0) dbNormalizedLandfalls() %>% distinct(lfid) }) lfNormalized <- reactive({ req(storm_selection$lf_id) lf <- dbNormalizedLandfalls() %>% filter(lfid == storm_selection$lf_id) %>% mutate( mmh = gdp_deflator * rwhu * affected_housing, mmp = gdp_deflator * rwpc * affected_population, years = as.Date(paste0(normalization_year, "-01-01")) ) %>% select( years, mmh, mmp ) lf_ts <- lf %>% select(-years) %>% xts(order.by = lf$years) cat(storm_selection$lf_id) cat(str(lf_ts)) return(lf_ts) }) fillCol( flex = c(.2, .8), fluidRow( column(4, selectInput("lfSelect", "Landfall Select", choices = NULL) ), column(4, #checkboxInput("mmhSelect", "Display MMH", value = T) ), column(4, #checkboxInput("mmpSelect", "Display MMP", value = T) ) ), dygraphOutput("costIndex") ) observe({ req(dbUniq(), nrow(dbUniq()) > 0) updateSelectInput( session, "lfSelect", choices = dbUniq()$lfid, selected = dbUniq()$lfid[1] ) updateSelectInput( session, "growthTrendLfSelect", choices = dbUniq()$lfid, selected = dbUniq()$lfid[1] ) storm_selection$lf_id = dbUniq()$lfid[1] }) observeEvent(input$lfSelect, { storm_selection$lf_id = input$lfSelect showNotification("Landfall updated", type = "message") }) output$costIndex <- renderDygraph({ req(lfNormalized()) dygraph(lfNormalized(), main = "Cost Index") %>% dySeries("mmh", label = "MMH") %>% dySeries("mmp", label = "MMP") %>% dyRangeSelector(height = 30) }) ``` Col {data-width=500} ------------------------------------ ### Fatalities {data-height=200} ```{r} fluidRow( column(6, HTML('
Katrina recorded 1,392 fatalities

Surge: 387

') ), column(6, actionLink("fatalitiesLink", tagList(icon("arrow-right"), "Fatalities dashboard"), class = "btn btn-outline") ) ) ``` ### Landfalls {data-height=300 .no-padding} ```{r} #selectLandfalls <- hurdat.best_track %>% # filter( # storm_name == storm_selection$storm_name & # storm_year == storm_selection$storm_year & # record_identifier == "L" # ) landfallsdata <- reactive({ req(storm_selection$is_selected) df <- selected.best_track() %>% filter(record_identifier == "L") %>% select( Date = datetime, Latitude = lat, Longitude = lon, Pressure = pressure, Windspeed = windspeed, RMW = rmw ) }) output$landfalls <- renderDT({ datatable( landfallsdata(), 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") ``` ### Storm Track {data-height=500 .no-padding} ```{r} output$trackMap <- renderLeaflet({ leaflet() %>% addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) %>% setView(lng = -80, lat = 32, zoom = 4) %>% addCircleMarkers( #data = katrinaTrack, #lng = ~Longitude, #lat = ~Latitude, data = selected.best_track(), lng = ~lon, lat = ~lat, radius = 5, color = ~ifelse(record_identifier == "L", "red", "blue"), fillColor = ~ifelse(record_identifier == "L", "red", "blue") ) }) 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 ===