--- title: "Hurricane Normalization App" runtime: shiny output: flexdashboard::flex_dashboard: orientation: columns vertical_layout: fill theme: version: 4 bootswatch: litera --- ```{r global, include=FALSE} 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() all_lf_type_storms <- get_all_lf_type_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 $3T 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") %>% 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} ------------------------------- ### Growth Year {data-height=100} ```{r} observe({ req(storm_selection$is_selected) updateSliderInput( session, "growth_trend_map_slider", min = storm_selection$storm_year, value = storm_selection$storm_year ) }) sliderInput( "growth_trend_map_slider", label = NULL, min = 1926, max = 2024, step = 1, animate = list( interval = 250, loop = F ), value = 1926, sep = "", width = "100%", ticks = F ) ``` ### Growth Map {data-height=700 .no-padding} ```{r} # Growth - Growth Map # TODO: implement data loading growth_counties <- reactive({ req( storm_selection$is_selected, 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({ leaflet() %>% addProviderTiles("Stadia.AlidadeSmooth") }) 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) %>% clearShapes() %>% addPolygons( fillColor = "red", color = "red", fillOpacity = ~population_opacity, weight = 2 ) } else { leafletProxy("growth_map", data = growth_county_year) %>% clearShapes() %>% addPolygons( fillColor = "blue", color = "blue", fillOpacity = ~housing_opacity, weight = 2 ) } }) leafletOutput("growth_map", height = "100%") ``` ### Map Control {data-height=200} ```{r} radioGroupButtons( "growth_map_metric", label = "Display Metric", choices = c("Population", "Housing"), selected = "Population", status = "outline-primary rounded-0", justified = T ) ``` 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") ``` Normalization Calculator {data-navmenu="Compute"} === ```{r} # Calculator - Setup Code calculator_storm_selection <- reactiveValues( storm_year = NULL, storm_name = NULL, storm_basin = NULL, full_lf_id = NULL, ) observeEvent(input$impact_populate_storm, { calculator_storm_selection$storm_basin = input$impact_storm_basin calculator_storm_selection$storm_year = input$impact_storm_year calculator_storm_selection$storm_name = input$impact_storm_name calculator_storm_selection$full_lf_id = input$impact_storm_full_lf_id calculator_storm_details <- get_lf_type_factors(calculator_storm_selection) updateTextInput( session, "impact_lat", value = calculator_storm_details$lat ) updateTextInput( session, "impact_lon", value = calculator_storm_details$lon ) updateTextInput( session, "impact_rmw", value = calculator_storm_details$rmw ) updateSliderInput( session, "impact_rmw_slider", value = calculator_storm_details$rmw ) updateTextInput( session, "impact_base_year", value = calculator_storm_details$storm_year ) updateTextInput( session, "impact_ref_year", value = "2024" ) updateTextInput( session, "impact_base_damage", value = calculator_storm_details$mwr ) }) ``` Column {data-width=700} --- ### Impact Map {.no-padding} ```{r} # Calculator - Impact Map output$impact_analysis_map <- renderLeaflet({ leaflet() %>% addProviderTiles("Stadia.AlidadeSmooth") #%>% #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%") ``` Column {data-width=300} --- ### {} ```{r} # Calculator - Input # TODO: add data population and compute observeEvent(input$impact_storm_year, { stormsByChosenYear <- all_lf_type_storms[all_lf_type_storms$storm_year == input$impact_storm_year, ] stormsByYear <- all_lf_type_storms %>% filter(storm_year == input$impact_storm_year) updateSelectInput( session, "impact_storm_name", choices = stormsByYear$storm_name, selected = NULL ) }) observeEvent(input$impact_storm_name, { uniqueLfs <- all_lf_type_storms %>% filter( storm_basin == input$impact_storm_basin, storm_year == input$impact_storm_year, storm_name == input$impact_storm_name ) updateSelectInput( session, "impact_storm_full_lf_id", choices = uniqueLfs$full_lf_id ) }) observe({ req( input$impact_lat, input$impact_lon ) new_lat <- as.numeric(input$impact_lat) new_lon <- as.numeric(input$impact_lon) if(new_lat >= -90 & new_lat <= 90 & new_lon >= -180 & new_lon <= 180) { rmw_meters <- input$impact_rmw_slider * 1852 leafletProxy("impact_analysis_map") %>% setView(lat = new_lat, lng = new_lon, zoom = 9) %>% clearShapes() %>% clearMarkers() %>% addCircleMarkers( lng = new_lon, lat = new_lat, radius = 2, weight = 0, color = "blue", fillColor = "blue", fillOpacity = 0.5 ) %>% addCircles( lng = new_lon, lat = new_lat, radius = rmw_meters, weight = 1, color = "blue", fillColor = "blue", fillOpacity = 0.05 ) } }) observe({ req(input$impact_rmw) if(as.numeric(input$impact_rmw) > 0) { updateSliderInput( session, "impact_rmw_slider", value = input$impact_rmw ) } }) observe({ req(input$impact_rmw_slider) updateTextInput( session, "impact_rmw", value = input$impact_rmw_slider ) }) observe({ req(input$impact_rmw, input$impact_rmw_slider) rmw_meters <- input$impact_rmw_slider * 1852 new_lon = input$impact_storm_lon new_lat = input$impact_storm_lat req(new_lon, new_lat) if(new_lat >= -90 & new_lat <= 90 & new_lon >= -180 & new_lon <= 180) { leafletProxy("impact_analysis_map") %>% clearShapes() %>% clearMarkers() %>% addCircleMarkers( lng = new_lon, lat = new_lat, radius = 2, weight = 0, color = "blue", fillColor = "blue", fillOpacity = 0.5 ) %>% addCircles( lng = new_lon, lat = new_lat, radius = rmw_meters, weight = 1, color = "blue", fillColor = "blue", fillOpacity = 0.05 ) } }) div( h6("Storm Selector"), fluidRow( column( 6, selectInput( "impact_storm_basin", label = NULL, choices = "AL", width = "100%" ), ), column( 6, selectInput( "impact_storm_year", label = NULL, choices = all_lf_type_storms$storm_year, width = "100%" ), ) ), fluidRow( column( 6, selectInput( "impact_storm_name", label = NULL, choices = NULL, width = "100%" ), ), column( 6, selectInput( "impact_storm_full_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"), selected = "2x", 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("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 ) }) leafletOutput("all_storms_map", height = "100%") ``` About ===