---
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.
- MMP24: The Muller-Mooney Population (2024) normalization with RMW weighting on affected population.
- MMH24: The Muller-Mooney Housing (2024) normalization with RMW weighting on affected housing units.
Methodology Innovations
Our platform incorporates several methodological innovations over previously used cost normalization formulas:
- Radius of Maximum Wind (RMW) Data: Using landfalling RMWs to identify impacted coastal counties.
- RMW Affected Area Weighting: Determining affected population and housing unit figures based on RMW.
- Expanded Storm Coverage: Including over 200 storms analyzed with interactive data.
- Up-to-date Data: Using the latest population, housing unit, and economic data through 2024.
'
)
```
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" ~ "#000000",
# Subtropical Depression
storm_status == "SD" ~ "#0055FF",
# Subtropical Storm
storm_status == "SS" ~ "#6CE2FF",
# Low
storm_status == "LO" ~ "#2AFF00",
# Wave
storm_status == "WV" ~ "#2AFF00",
# Disturbance
storm_status == "DB" ~ "#2AFF00",
# Missing
TRUE ~ "#CCCCCC"
),
line_stroke = case_when(
# Add dashed lines for certain storm_status
storm_status == "TD" ~ "0",
storm_status == "TS" ~ "0",
storm_status == "HU" ~ "0",
storm_status == "EX" ~ "0",
storm_status == "SD" ~ "0",
storm_status == "SS" ~ "0",
storm_status == "LO" ~ "5,5",
storm_status == "WV" ~ "5,5",
storm_status == "DB" ~ "5,5",
TRUE ~ "0"
),
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),
)
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],
dashArray = track_data$line_stroke[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
===