---
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)
# 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"))
# 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 .tabset}
------------------------------------
### Track Map {.no-padding}
```{r}
# Overview - Track Map
storm_track <- reactive({
req(storm_selection$is_selected)
result <- get_hurdat_track(storm_selection)
return(result)
})
output$track_map <- renderLeaflet({
leaflet() %>%
addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18))
})
observe({
req(storm_selection)
storm_track <- storm_track()
first_lf <- storm_track %>%
filter(
record_identifier == "L"
) %>%
arrange(
desc(datetime)
)
if(nrow(first_lf) > 0) {
map_center <- first_lf %>%
head(1)
}else{
map_center <- data.frame(
lon = c(-76),
lat = c(35)
)
}
leafletProxy("track_map", data = storm_track) %>%
clearShapes() %>%
clearMarkers() %>%
setView(
lng = map_center$lon,
lat = map_center$lat,
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("track_map", height = "100%")
```
### Track Data {.no-padding}
```{r}
# Overview - Track Data
output$track_data <- renderDT({
datatable(
storm_track() %>% select(datetime, storm_status, lon, lat, rmw, pressure, windspeed, record_identifier),
rownames = F,
colnames = c("Date", "Status", "Lon", "Lat", "RMW", "Pressure", "Windpseed", "Identifier"),
selection = "none",
options = list(
pageLength = 1000,
order = list(0, 'desc'),
searching = F,
paging = F,
info = F,
lengthChange = F,
server = T
)
)
})
DTOutput("track_data")
```
Col {data-width=500}
------------------------------------
### Normalization Cost Index {data-height=700}
```{r}
# Overview - Normalization Chart
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()
})
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")
)
)
```
### Landfalls {data-height=300 .no-padding}
```{r}
# Overview - Landfalls Table
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")
})
DTOutput("landfalls_table")
```
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"}
===
### {}
```{r}
# TODO: add all storms fatality data and charting
```
Column {data-width=500}
---
### {data-height=500}
```{r}
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}
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")
```
Column {data-width=500}
---
### {data-height=500}
```{r}
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}
```
About
===