mirror of
https://github.com/dylanbenzi/hurricane_normalization_app.git
synced 2026-07-29 21:01:27 +00:00
update entire app to begin using bslib instead of flexdashboard
This commit is contained in:
Vendored
+13
@@ -25,6 +25,19 @@
|
||||
"kind": "test",
|
||||
"isDefault": true
|
||||
}
|
||||
},
|
||||
{
|
||||
"label": "Run Shiny App",
|
||||
"type": "shell",
|
||||
"command": "Rscript",
|
||||
"args": [
|
||||
"-e",
|
||||
"\"options(shiny.autoreload = TRUE); shiny::runApp('app/app.R', port = 1234, )\""
|
||||
],
|
||||
"group": {
|
||||
"kind": "test",
|
||||
"isDefault": true
|
||||
}
|
||||
}
|
||||
]
|
||||
}
|
||||
@@ -0,0 +1,5 @@
|
||||
source("global.R")
|
||||
source("ui.R")
|
||||
source("server.R")
|
||||
|
||||
shinyApp(ui = ui, server = server)
|
||||
@@ -0,0 +1,58 @@
|
||||
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)
|
||||
library(quarto)
|
||||
|
||||
APP_DIR <- getwd()
|
||||
|
||||
cache_dir <- file.path(APP_DIR, "cache")
|
||||
cache_logfile <- file.path(APP_DIR, "cachelog")
|
||||
|
||||
source(file = "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()
|
||||
|
||||
onStop(function() {
|
||||
disconnect_db()
|
||||
})
|
||||
|
||||
storm_selection <- reactiveValues(
|
||||
storm_year = NULL,
|
||||
storm_name = NULL,
|
||||
storm_basin = NULL,
|
||||
hurdatid = NULL
|
||||
)
|
||||
+30
-124
@@ -4,11 +4,7 @@ library(tidyverse)
|
||||
library(dplyr)
|
||||
library(DBI)
|
||||
library(xts)
|
||||
library(memoise)
|
||||
library(cachem)
|
||||
library(digest)
|
||||
|
||||
APP_DIR <- getwd()
|
||||
|
||||
config <- config::get(file = "config.yml")
|
||||
|
||||
@@ -22,21 +18,7 @@ con <- dbConnect(
|
||||
password = config$db_password
|
||||
)
|
||||
|
||||
.tbl_cache <- new.env(parent = emptyenv())
|
||||
|
||||
get_tbl <- function(name, schema = NULL) {
|
||||
key <- if (is.null(schema)) name else paste0(schema, ".", name)
|
||||
|
||||
if (!exists(key, .tbl_cache)) {
|
||||
if (is.null(schema)) {
|
||||
.tbl_cache[[key]] <- tbl(con, name)
|
||||
} else {
|
||||
.tbl_cache[[key]] <- tbl(con, I(paste0(schema, ".", name)))
|
||||
}
|
||||
}
|
||||
|
||||
.tbl_cache[[key]]
|
||||
}
|
||||
#qry <- econ.storm_base_loss %>%
|
||||
# left_join(view.hurdat_track, by = c("storm_basin", "storm_year", "storm_name"))
|
||||
|
||||
@@ -83,7 +65,7 @@ split_full_lf_id <- function(full_lf_id) {
|
||||
# DB getters
|
||||
|
||||
get_yearly_economics <- function(yr) {
|
||||
query <- get_tbl("usa_yearly", "econ") %>%
|
||||
query <- tbl(con, I("econ.usa_yearly")) %>%
|
||||
filter(year == yr)
|
||||
|
||||
result <- query %>% collect()
|
||||
@@ -92,7 +74,7 @@ get_yearly_economics <- function(yr) {
|
||||
}
|
||||
|
||||
get_latest_normalization_year <- function() {
|
||||
query <- get_tbl("all_yearly_normalized_losses") %>%
|
||||
query <- tbl(con, "all_yearly_normalized_losses") %>%
|
||||
summarize(latest_year = max(normalization_year))
|
||||
|
||||
result <- query %>% collect()
|
||||
@@ -101,7 +83,7 @@ get_latest_normalization_year <- function() {
|
||||
}
|
||||
|
||||
get_storm_data_coverage <- function() {
|
||||
query <- get_tbl("storm_data_coverage")
|
||||
query <- tbl(con, "storm_data_coverage")
|
||||
|
||||
result <- query %>% collect()
|
||||
|
||||
@@ -109,7 +91,7 @@ get_storm_data_coverage <- function() {
|
||||
}
|
||||
|
||||
get_yearly_usa_pop_hu <- function(yr) {
|
||||
query <- get_tbl("usa_pop_hu", "metrics") %>%
|
||||
query <- tbl(con, I("metrics.usa_pop_hu")) %>%
|
||||
filter(year == yr)
|
||||
|
||||
result <- query %>% collect()
|
||||
@@ -118,7 +100,7 @@ get_yearly_usa_pop_hu <- function(yr) {
|
||||
}
|
||||
|
||||
get_best_track_summary <- function(storm) {
|
||||
query <- get_tbl("best_track_summary") %>%
|
||||
query <- tbl(con, "best_track_summary") %>%
|
||||
filter(
|
||||
storm_basin == storm$storm_basin,
|
||||
storm_year == storm$storm_year,
|
||||
@@ -131,7 +113,7 @@ get_best_track_summary <- function(storm) {
|
||||
}
|
||||
|
||||
get_hurdat_id <- function(storm) {
|
||||
query <- get_tbl("hurdat_ids") %>%
|
||||
query <- tbl(con, "hurdat_ids") %>%
|
||||
filter(
|
||||
storm_basin == storm$storm_basin,
|
||||
storm_year == storm$storm_year,
|
||||
@@ -145,7 +127,7 @@ get_hurdat_id <- function(storm) {
|
||||
|
||||
# returns a list of loss storms we have data on
|
||||
get_all_loss_storms <- function() {
|
||||
query <- get_tbl("all_loss_storms")
|
||||
query <- tbl(con, "all_loss_storms")
|
||||
|
||||
result <- query %>% collect()
|
||||
|
||||
@@ -154,7 +136,7 @@ get_all_loss_storms <- function() {
|
||||
|
||||
# returns a list of all stored hurdat ids
|
||||
get_all_hurdat_ids <- function() {
|
||||
query <- get_tbl("hurdat_ids")
|
||||
query <- tbl(con, "hurdat_ids")
|
||||
|
||||
result <- query %>% collect()
|
||||
|
||||
@@ -163,7 +145,7 @@ get_all_hurdat_ids <- function() {
|
||||
|
||||
# returns a list of latest normalized losses
|
||||
get_latest_aggregate_losses <- function() {
|
||||
query <- get_tbl("all_normalized_losses")
|
||||
query <- tbl(con, "all_normalized_losses")
|
||||
|
||||
result <- query %>% collect()
|
||||
|
||||
@@ -171,7 +153,7 @@ get_latest_aggregate_losses <- function() {
|
||||
}
|
||||
|
||||
get_latest_aggregate_loss <- function(storm) {
|
||||
query <- get_tbl("all_normalized_losses") %>%
|
||||
query <- tbl(con, "all_normalized_losses") %>%
|
||||
filter(
|
||||
storm_year == storm$storm_year,
|
||||
storm_name == storm$storm_name
|
||||
@@ -184,7 +166,7 @@ get_latest_aggregate_loss <- function(storm) {
|
||||
|
||||
# returns unique lf ids for a storm
|
||||
get_unique_lf_ids <- function(storm) {
|
||||
query <- get_tbl("all_loss_landfalls") %>%
|
||||
query <- tbl(con, "all_loss_landfalls") %>%
|
||||
filter(
|
||||
storm_basin == storm$storm_basin,
|
||||
storm_year == storm$storm_year,
|
||||
@@ -215,7 +197,7 @@ get_unique_lf_ids <- function(storm) {
|
||||
get_normalized_cost_index <- function(storm, full_lf_id) {
|
||||
lf_id_parts <- split_full_lf_id(full_lf_id)
|
||||
|
||||
query <- get_tbl("all_yearly_normalized_losses") %>%
|
||||
query <- tbl(con, "all_yearly_normalized_losses") %>%
|
||||
filter(
|
||||
storm_basin == storm$storm_basin,
|
||||
storm_year == storm$storm_year,
|
||||
@@ -234,58 +216,9 @@ get_normalized_cost_index <- function(storm, full_lf_id) {
|
||||
return(result)
|
||||
}
|
||||
|
||||
test_query <- function() {
|
||||
result <- dbGetQuery(
|
||||
con,
|
||||
"WITH yearly_totals AS (
|
||||
SELECT
|
||||
year,
|
||||
SUM(population) as total_population,
|
||||
SUM(housing_units) as total_housing_units
|
||||
FROM metrics.pop_and_housing
|
||||
WHERE state_fips = '12'
|
||||
AND county_fips IN ('011', '021', '086', '087')
|
||||
AND year BETWEEN 1926 AND 2024
|
||||
GROUP BY year
|
||||
),
|
||||
base_year AS (
|
||||
SELECT
|
||||
total_population as base_population,
|
||||
total_housing_units as base_housing
|
||||
FROM yearly_totals
|
||||
WHERE year = (SELECT MIN(year) FROM yearly_totals) -- Uses first year in dataset as base
|
||||
)
|
||||
SELECT
|
||||
year,
|
||||
total_population,
|
||||
total_housing_units,
|
||||
ROUND(total_population / base_population, 4) as population_index,
|
||||
ROUND(total_housing_units / base_housing, 4) as housing_index
|
||||
FROM yearly_totals
|
||||
CROSS JOIN base_year
|
||||
ORDER BY year;"
|
||||
)
|
||||
|
||||
result <- result %>%
|
||||
mutate(
|
||||
year = as.Date(paste0(year, "-01-01"))
|
||||
) %>%
|
||||
select(
|
||||
year,
|
||||
population_index,
|
||||
housing_index
|
||||
)
|
||||
|
||||
result_ts <- result %>%
|
||||
select(-year) %>%
|
||||
xts(order.by = result$year)
|
||||
|
||||
return(result_ts)
|
||||
}
|
||||
|
||||
# returns normalized mmh/mmp indexes and costs over time by storm
|
||||
get_all_normalized_cost_index <- function(storm) {
|
||||
query <- get_tbl("all_yearly_normalized_losses") %>%
|
||||
query <- tbl(con, "all_yearly_normalized_losses") %>%
|
||||
filter(
|
||||
storm_basin == storm$storm_basin,
|
||||
storm_year == storm$storm_year,
|
||||
@@ -310,7 +243,7 @@ get_all_normalized_cost_index <- function(storm) {
|
||||
|
||||
# returns landfalls and data at landfall from HURDAT
|
||||
get_hurdat_landfalls <- function(storm) {
|
||||
query <- get_tbl("hurdat_track") %>%
|
||||
query <- tbl(con, "hurdat_track") %>%
|
||||
filter(
|
||||
storm_basin == storm$storm_basin,
|
||||
storm_year == storm$storm_year,
|
||||
@@ -342,7 +275,7 @@ get_hurdat_landfalls <- function(storm) {
|
||||
|
||||
# returns all tracked storm conus landfalls
|
||||
get_all_conus_landfalls <- function() {
|
||||
query <- get_tbl("all_conus_landfalls") %>%
|
||||
query <- tbl(con, "all_conus_landfalls") %>%
|
||||
select(
|
||||
storm_year,
|
||||
storm_name,
|
||||
@@ -358,7 +291,7 @@ get_all_conus_landfalls <- function() {
|
||||
|
||||
# returns all storm tracks from HURDAT
|
||||
get_all_hurdat_tracks <- function() {
|
||||
query <- get_tbl("all_loss_storms_tracks")
|
||||
query <- tbl(con, "all_loss_storms_tracks")
|
||||
|
||||
result <- query %>% collect()
|
||||
|
||||
@@ -367,7 +300,7 @@ get_all_hurdat_tracks <- function() {
|
||||
|
||||
# returns storm track from HURDAT
|
||||
get_hurdat_track <- function(storm) {
|
||||
query <- get_tbl("hurdat_track") %>%
|
||||
query <- tbl(con, "hurdat_track") %>%
|
||||
filter(
|
||||
storm_basin == storm$storm_basin,
|
||||
storm_year == storm$storm_year,
|
||||
@@ -416,7 +349,7 @@ get_normalized_metric_growth <- function(storm, full_lf_id) {
|
||||
lf_id_parts <- split_full_lf_id(full_lf_id)
|
||||
|
||||
if (lf_id_parts$lf_type == 'LF') {
|
||||
affected_counties <- get_tbl("affected_area_landfalls", "gis") %>%
|
||||
affected_counties <- tbl(con, I("gis.affected_area_landfalls")) %>%
|
||||
filter(
|
||||
storm_basin == storm$storm_basin,
|
||||
storm_year == storm$storm_year,
|
||||
@@ -426,11 +359,11 @@ get_normalized_metric_growth <- function(storm, full_lf_id) {
|
||||
) %>%
|
||||
select(state_fips, county_fips)
|
||||
|
||||
query <- get_tbl("pop_housing_normalized_growth", "metrics") %>%
|
||||
filter(base_year == storm$storm_year) %>%
|
||||
query <- tbl(con, I("metrics.pop_housing_normalized_growth")) %>%
|
||||
filter(base_year_population == storm$storm_year) %>%
|
||||
inner_join(affected_counties, by = c("state_fips", "county_fips")) %>%
|
||||
inner_join(
|
||||
get_tbl("counties", "public"),
|
||||
tbl(con, I("public.counties")),
|
||||
by = c("state_fips" = "statefp", "county_fips" = "countyfp")
|
||||
) %>%
|
||||
mutate(
|
||||
@@ -471,7 +404,7 @@ get_normalized_metric_growth <- function(storm, full_lf_id) {
|
||||
|
||||
return(result)
|
||||
} else {
|
||||
affected_state <- get_tbl("indirect_landfalls", "gis") %>%
|
||||
affected_state <- tbl(con, I("gis.indirect_landfalls")) %>%
|
||||
filter(
|
||||
storm_basin == storm$storm_basin,
|
||||
storm_year == storm$storm_year,
|
||||
@@ -483,7 +416,7 @@ get_normalized_metric_growth <- function(storm, full_lf_id) {
|
||||
state_fips
|
||||
)
|
||||
|
||||
baseline_metrics <- get_tbl("yearly_state_metrics") %>%
|
||||
baseline_metrics <- tbl(con, "yearly_state_metrics") %>%
|
||||
filter(year == storm$storm_year) %>%
|
||||
inner_join(affected_state, by = "state_fips") %>%
|
||||
select(
|
||||
@@ -492,7 +425,7 @@ get_normalized_metric_growth <- function(storm, full_lf_id) {
|
||||
baseline_housing = state_housing_units
|
||||
)
|
||||
|
||||
normalized_metrics <- get_tbl("yearly_state_metrics") %>%
|
||||
normalized_metrics <- tbl(con, "yearly_state_metrics") %>%
|
||||
filter(
|
||||
year >= storm$storm_year
|
||||
) %>%
|
||||
@@ -515,7 +448,7 @@ get_normalized_metric_growth <- function(storm, full_lf_id) {
|
||||
|
||||
query <- normalized_metrics %>%
|
||||
inner_join(
|
||||
get_tbl("us_states_boundary", "gis") %>%
|
||||
tbl(con, I("gis.us_states_boundary")) %>%
|
||||
rename(state_fips = statefp),
|
||||
by = "state_fips"
|
||||
) %>%
|
||||
@@ -544,7 +477,7 @@ get_normalized_metric_growth <- function(storm, full_lf_id) {
|
||||
|
||||
# returns all lf type landfalls
|
||||
get_all_lf_type_landfalls <- function() {
|
||||
query <- get_tbl("lf_id_location")
|
||||
query <- tbl(con, "lf_id_location")
|
||||
|
||||
result <- query %>% collect()
|
||||
|
||||
@@ -553,7 +486,7 @@ get_all_lf_type_landfalls <- function() {
|
||||
|
||||
# returns all storms and factors needed to normalize a lf type landfall
|
||||
get_all_lf_type_factors <- function() {
|
||||
query <- get_tbl("lf_landfall_gis")
|
||||
query <- tbl(con, "lf_landfall_gis")
|
||||
|
||||
result <- query %>% collect()
|
||||
|
||||
@@ -562,7 +495,7 @@ get_all_lf_type_factors <- function() {
|
||||
|
||||
# returns one storm and factors needed to normalize a lf type landfall
|
||||
get_lf_type_factors <- function(storm) {
|
||||
query <- get_tbl("lf_landfall_gis") %>%
|
||||
query <- tbl(con, "lf_landfall_gis") %>%
|
||||
filter(
|
||||
storm_basin == storm$storm_basin,
|
||||
storm_year == storm$storm_year,
|
||||
@@ -579,7 +512,7 @@ get_county_and_state <- function(df) {
|
||||
unique_state_fips <- unique(df$state_fips)
|
||||
unique_county_fips <- unique(df$county_fips)
|
||||
|
||||
counties <- get_tbl("counties", "public") %>%
|
||||
counties <- tbl(con, I("public.counties")) %>%
|
||||
filter(
|
||||
statefp %in% !!unique_state_fips,
|
||||
countyfp %in% !!unique_county_fips
|
||||
@@ -592,7 +525,7 @@ get_county_and_state <- function(df) {
|
||||
) %>%
|
||||
collect()
|
||||
|
||||
states <- get_tbl("states", "fips") %>%
|
||||
states <- tbl(con, I("fips.states")) %>%
|
||||
filter(state_fips %in% !!unique_state_fips) %>%
|
||||
select(
|
||||
state_fips,
|
||||
@@ -614,30 +547,3 @@ get_county_and_state <- function(df) {
|
||||
return(result)
|
||||
}
|
||||
|
||||
cache_dir <- file.path(APP_DIR, "cache")
|
||||
cache_logfile <- file.path(APP_DIR, "cachelog")
|
||||
|
||||
if (!dir.exists(cache_dir)) {
|
||||
dir.create(cache_dir, recursive = TRUE)
|
||||
}
|
||||
|
||||
query_cache <- cachem::cache_disk(
|
||||
dir = cache_dir,
|
||||
max_age = Inf,
|
||||
evict = "lru",
|
||||
logfile = cache_logfile
|
||||
)
|
||||
|
||||
get_latest_normalization_year <- memoise(
|
||||
get_latest_normalization_year,
|
||||
cache = query_cache
|
||||
)
|
||||
get_all_loss_storms <- memoise(get_all_loss_storms, cache = query_cache)
|
||||
get_all_hurdat_ids <- memoise(get_all_hurdat_ids, cache = query_cache)
|
||||
get_latest_aggregate_losses <- memoise(
|
||||
get_latest_aggregate_losses,
|
||||
cache = query_cache
|
||||
)
|
||||
get_all_conus_landfalls <- memoise(get_all_conus_landfalls, cache = query_cache)
|
||||
get_all_hurdat_tracks <- memoise(get_all_hurdat_tracks, cache = query_cache)
|
||||
get_all_lf_type_factors <- memoise(get_all_lf_type_factors, cache = query_cache)
|
||||
|
||||
+721
@@ -0,0 +1,721 @@
|
||||
server <- function(input, output, session) {
|
||||
storm_coverage <- get_storm_data_coverage() %>%
|
||||
select(-storm_basin) %>%
|
||||
{
|
||||
col_names <- names(.)
|
||||
mutate(
|
||||
.,
|
||||
data = trimws(paste(
|
||||
ifelse(
|
||||
as.logical(.data[[col_names[3]]]),
|
||||
'<span class="badge badge-primary">Fatality</span>',
|
||||
""
|
||||
),
|
||||
ifelse(
|
||||
as.logical(.data[[col_names[4]]]),
|
||||
'<span class="badge badge-success">Cost</span>',
|
||||
""
|
||||
)
|
||||
))
|
||||
) %>%
|
||||
select(1, 2, data)
|
||||
}
|
||||
|
||||
output$storm_coverage_table <- renderDT({
|
||||
datatable(
|
||||
storm_coverage,
|
||||
rownames = F,
|
||||
escape = F,
|
||||
colnames = c("Year", "Name", "Data"),
|
||||
selection = "single",
|
||||
options = list(
|
||||
pageLength = 1000,
|
||||
order = list(0, 'desc'),
|
||||
searching = F,
|
||||
paging = F,
|
||||
info = F,
|
||||
lengthChange = F
|
||||
)
|
||||
)
|
||||
})
|
||||
|
||||
dt_storm_selected <- reactive({
|
||||
req(input$storm_coverage_table_rows_selected)
|
||||
storm_coverage[input$storm_coverage_table_rows_selected, ]
|
||||
})
|
||||
|
||||
output$dt_storm_name_year <- renderText({
|
||||
paste0(
|
||||
dt_storm_selected()$storm_name,
|
||||
" (",
|
||||
dt_storm_selected()$storm_year,
|
||||
")"
|
||||
)
|
||||
})
|
||||
|
||||
output$selected_storm_name_year <- renderText({
|
||||
if (is.null(storm_selection$storm_name)) {
|
||||
"Select a storm"
|
||||
} else {
|
||||
paste0(
|
||||
storm_selection$storm_name,
|
||||
" (",
|
||||
storm_selection$storm_year,
|
||||
")"
|
||||
)
|
||||
}
|
||||
})
|
||||
|
||||
observe({
|
||||
req(
|
||||
storm_selection$storm_basin,
|
||||
storm_selection$storm_year,
|
||||
storm_selection$storm_name
|
||||
)
|
||||
|
||||
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]
|
||||
)
|
||||
})
|
||||
|
||||
observeEvent(input$load_storm, {
|
||||
storm_selection$storm_basin <- "AL"
|
||||
storm_selection$storm_year <- dt_storm_selected()$storm_year
|
||||
storm_selection$storm_name <- dt_storm_selected()$storm_name
|
||||
|
||||
hurdatid <- get_hurdat_id(storm_selection)
|
||||
storm_selection$hurdatid = hurdatid$hurdatid
|
||||
|
||||
selected_storm <-
|
||||
paste0(
|
||||
dt_storm_selected()$storm_name,
|
||||
" (",
|
||||
dt_storm_selected()$storm_year,
|
||||
")"
|
||||
)
|
||||
|
||||
nav_select("main_navbar", "Storm Explorer")
|
||||
})
|
||||
|
||||
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
|
||||
)
|
||||
})
|
||||
|
||||
storm_track <- reactive({
|
||||
req(
|
||||
storm_selection$storm_basin,
|
||||
storm_selection$storm_year,
|
||||
storm_selection$storm_name
|
||||
)
|
||||
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)
|
||||
}) %>%
|
||||
bindCache(
|
||||
storm_selection$storm_year,
|
||||
storm_selection$storm_name,
|
||||
storm_selection$storm_basin
|
||||
)
|
||||
|
||||
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(
|
||||
"<b>DATE</b>",
|
||||
"<br>",
|
||||
datetime,
|
||||
"<br>",
|
||||
"<b>CATEGORY</b>",
|
||||
"<br>",
|
||||
popup_category,
|
||||
"<br>",
|
||||
"<b>WINDSPEED</b>",
|
||||
"<br>",
|
||||
windspeed,
|
||||
"kt",
|
||||
"<br>",
|
||||
"<b>PRESSURE</b>",
|
||||
"<br>",
|
||||
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(
|
||||
"<b>LANDFALL</b>",
|
||||
"<br>",
|
||||
"<b>DATE</b>",
|
||||
"<br>",
|
||||
datetime,
|
||||
"<br>",
|
||||
"<b>CATEGORY</b>",
|
||||
"<br>",
|
||||
popup_category,
|
||||
"<br>",
|
||||
"<b>WINDSPEED</b>",
|
||||
"<br>",
|
||||
windspeed,
|
||||
"kt",
|
||||
"<br>",
|
||||
"<b>PRESSURE</b>",
|
||||
"<br>",
|
||||
pressure,
|
||||
"mb",
|
||||
"<br>",
|
||||
"<b>RMW</b>",
|
||||
"<br>",
|
||||
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(
|
||||
"<b>LANDFALL</b>",
|
||||
"<br>",
|
||||
"<b>DATE</b>",
|
||||
"<br>",
|
||||
datetime,
|
||||
"<br>",
|
||||
"<b>CATEGORY</b>",
|
||||
"<br>",
|
||||
popup_category,
|
||||
"<br>",
|
||||
"<b>WINDSPEED</b>",
|
||||
"<br>",
|
||||
windspeed,
|
||||
"kt",
|
||||
"<br>",
|
||||
"<b>PRESSURE</b>",
|
||||
"<br>",
|
||||
pressure,
|
||||
"mb",
|
||||
"<br>",
|
||||
"<b>RMW</b>",
|
||||
"<br>",
|
||||
rmw,
|
||||
"nm"
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
return(map)
|
||||
})
|
||||
|
||||
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
|
||||
)
|
||||
)
|
||||
})
|
||||
|
||||
storm_yearly_normalization <- reactive({
|
||||
req(
|
||||
storm_selection$storm_basin,
|
||||
storm_selection$storm_year,
|
||||
storm_selection$storm_name
|
||||
)
|
||||
|
||||
result <- get_all_normalized_cost_index(storm_selection)
|
||||
|
||||
return(result)
|
||||
}) %>%
|
||||
bindCache(
|
||||
storm_selection$storm_year,
|
||||
storm_selection$storm_name,
|
||||
storm_selection$storm_basin
|
||||
)
|
||||
|
||||
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) %>%
|
||||
dyLegend(show = "always", width = 400, hideOnMouseOut = FALSE) %>%
|
||||
dyRangeSelector()
|
||||
}) %>%
|
||||
bindCache(
|
||||
storm_selection$storm_year,
|
||||
storm_selection$storm_name,
|
||||
storm_selection$storm_basin,
|
||||
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
|
||||
)
|
||||
|
||||
observe({
|
||||
req(
|
||||
storm_selection$storm_basin,
|
||||
storm_selection$storm_year,
|
||||
storm_selection$storm_name
|
||||
)
|
||||
|
||||
updateSliderInput(
|
||||
session,
|
||||
"growth_trend_map_slider",
|
||||
min = storm_selection$storm_year,
|
||||
value = storm_selection$storm_year
|
||||
)
|
||||
})
|
||||
|
||||
growth_counties <- reactive({
|
||||
req(
|
||||
storm_selection$storm_basin,
|
||||
storm_selection$storm_year,
|
||||
storm_selection$storm_name,
|
||||
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)
|
||||
}) %>%
|
||||
bindCache(
|
||||
storm_selection$storm_year,
|
||||
storm_selection$storm_name,
|
||||
storm_selection$storm_basin,
|
||||
input$growth_trend_lf_select
|
||||
)
|
||||
|
||||
output$growth_map <- renderLeaflet({
|
||||
req(
|
||||
growth_counties(),
|
||||
input$growth_trend_map_slider,
|
||||
input$growth_map_metric
|
||||
)
|
||||
|
||||
counties_data <- growth_counties()
|
||||
combined_geom <- st_union(counties_data)
|
||||
growth_bbox <- st_bbox(combined_geom)
|
||||
|
||||
growth_year <- input$growth_trend_map_slider
|
||||
growth_county_year <- counties_data %>%
|
||||
filter(year == growth_year)
|
||||
|
||||
map <- leaflet() %>%
|
||||
addProviderTiles("Stadia.AlidadeSmooth") %>%
|
||||
fitBounds(
|
||||
lng1 = growth_bbox[["xmin"]],
|
||||
lng2 = growth_bbox[["xmax"]],
|
||||
lat1 = growth_bbox[["ymin"]],
|
||||
lat2 = growth_bbox[["ymax"]]
|
||||
)
|
||||
|
||||
if (input$growth_map_metric == "Population") {
|
||||
map <- map %>%
|
||||
addPolygons(
|
||||
data = growth_county_year,
|
||||
group = "counties",
|
||||
fillColor = "red",
|
||||
color = "red",
|
||||
fillOpacity = ~population_opacity,
|
||||
weight = 1,
|
||||
popup = ~name
|
||||
)
|
||||
} else {
|
||||
map <- map %>%
|
||||
addPolygons(
|
||||
data = growth_county_year,
|
||||
group = "counties",
|
||||
fillColor = "blue",
|
||||
color = "blue",
|
||||
fillOpacity = ~housing_opacity,
|
||||
weight = 1,
|
||||
popup = ~name
|
||||
)
|
||||
}
|
||||
|
||||
return(map)
|
||||
})
|
||||
|
||||
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) %>%
|
||||
clearGroup("counties") %>%
|
||||
addPolygons(
|
||||
group = "counties",
|
||||
fillColor = "red",
|
||||
color = "red",
|
||||
fillOpacity = ~population_opacity,
|
||||
weight = 1,
|
||||
popup = ~name
|
||||
)
|
||||
} else {
|
||||
leafletProxy("growth_map", data = growth_county_year) %>%
|
||||
clearGroup("counties") %>%
|
||||
addPolygons(
|
||||
group = "counties",
|
||||
fillColor = "blue",
|
||||
color = "blue",
|
||||
fillOpacity = ~housing_opacity,
|
||||
weight = 1,
|
||||
popup = ~name
|
||||
)
|
||||
}
|
||||
})
|
||||
}
|
||||
@@ -0,0 +1,230 @@
|
||||
library(bslib)
|
||||
|
||||
ui <- page_navbar(
|
||||
id = "main_navbar",
|
||||
fillable = TRUE,
|
||||
title = "Tropical Cyclone Database",
|
||||
theme = bs_theme(
|
||||
bootswatch = "sandstone"
|
||||
),
|
||||
nav_panel(
|
||||
"Home",
|
||||
card(
|
||||
"Welcome to the Tropical Cyclone Database",
|
||||
HTML(
|
||||
'
|
||||
<h4>Welcome to the Hurricane Cost Normalization Web App</h4>
|
||||
|
||||
<p>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.</p>
|
||||
|
||||
<h6>Our Data</h6>
|
||||
|
||||
<p>The core datasets used in this app are based on research by Muller et al. (2025) published in <i>Bulletin of the American Meteorlogical Society</i>. This study updates and refines hurricane damage normalization methodologies to provide a more accurate picture of how historical hurricanes would impact today\'s society.</p>
|
||||
|
||||
<ul>
|
||||
<li><b>MMP24:</b> The Muller-Mooney Population (2024) normalization with RMW weighting on affected population.</li>
|
||||
|
||||
<li><b>MMH24:</b> The Muller-Mooney Housing (2024) normalization with RMW weighting on affected housing units.</li>
|
||||
</ul>
|
||||
|
||||
<h6>Methodology Innovations</h6>
|
||||
|
||||
<p>Our platform incorporates several methodological innovations over previously used cost normalization formulas:
|
||||
|
||||
<ul>
|
||||
<li><b>Radius of Maximum Wind (RMW) Data:</b> Using landfalling RMWs to identify impacted coastal counties.</li>
|
||||
|
||||
<li><b>RMW Affected Area Weighting:</b> Determining affected population and housing unit figures based on RMW.</li>
|
||||
|
||||
<li><b>Expanded Storm Coverage:</b> Including over 200 storms analyzed with interactive data.</li>
|
||||
|
||||
<li><b>Up-to-date Data:</b> Using the latest population, housing unit, and economic data through 2024.</li>
|
||||
</ul>
|
||||
'
|
||||
)
|
||||
)
|
||||
),
|
||||
nav_panel(
|
||||
"Storm Selector",
|
||||
layout_columns(
|
||||
col_widths = c(8, 4),
|
||||
card(
|
||||
DTOutput("storm_coverage_table")
|
||||
),
|
||||
layout_columns(
|
||||
col_widths = 12,
|
||||
card(
|
||||
height = 250,
|
||||
h4(strong(textOutput("dt_storm_name_year"))),
|
||||
p("Category X - Landfall: FL"),
|
||||
div(),
|
||||
hr(),
|
||||
layout_columns(
|
||||
col_widths = c(6, 6),
|
||||
div(),
|
||||
div(),
|
||||
div(),
|
||||
div()
|
||||
),
|
||||
actionButton("load_storm", "Load Storm")
|
||||
),
|
||||
card(
|
||||
height = 750,
|
||||
card_body(
|
||||
class = "p-0",
|
||||
leafletOutput("all_storms_map", height = "100%")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
),
|
||||
nav_panel(
|
||||
title = "Storm Explorer",
|
||||
navset_underline(
|
||||
nav_item(strong(textOutput("selected_storm_name_year"))),
|
||||
nav_panel(
|
||||
"Track",
|
||||
layout_columns(
|
||||
col_widths = 6,
|
||||
card(
|
||||
full_screen = TRUE,
|
||||
card_body(
|
||||
class = "p-0",
|
||||
leafletOutput("track_map", height = "100%")
|
||||
)
|
||||
),
|
||||
card(
|
||||
card_body(
|
||||
class = "p-0",
|
||||
DTOutput("track_data", height = "100%")
|
||||
)
|
||||
)
|
||||
)
|
||||
),
|
||||
nav_panel("Meterology"),
|
||||
nav_panel(
|
||||
"Cost Normalization",
|
||||
layout_columns(
|
||||
col_widths = 6,
|
||||
card(
|
||||
"MMH/MMP Normalization",
|
||||
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"))
|
||||
)
|
||||
)
|
||||
),
|
||||
card(),
|
||||
card(),
|
||||
card()
|
||||
)
|
||||
),
|
||||
nav_panel(
|
||||
"Human Factors",
|
||||
layout_columns(
|
||||
col_widths = 6,
|
||||
layout_columns(
|
||||
col_widths = 12,
|
||||
|
||||
card(
|
||||
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
|
||||
)
|
||||
),
|
||||
card(
|
||||
leafletOutput("growth_map", height = "100%")
|
||||
),
|
||||
card(
|
||||
fluidRow(
|
||||
column(
|
||||
6,
|
||||
selectInput(
|
||||
"growth_trend_lf_select",
|
||||
"Landfall Select",
|
||||
choices = NULL
|
||||
)
|
||||
),
|
||||
column(
|
||||
6,
|
||||
radioGroupButtons(
|
||||
"growth_map_metric",
|
||||
label = "Display Metric",
|
||||
choices = c("Population", "Housing"),
|
||||
selected = "Population",
|
||||
status = "outline-primary rounded-0",
|
||||
justified = T
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
),
|
||||
nav_panel("Perils"),
|
||||
nav_panel("Fatality Map"),
|
||||
nav_spacer(),
|
||||
nav_menu(
|
||||
title = "Export",
|
||||
nav_item("Storm report")
|
||||
)
|
||||
)
|
||||
),
|
||||
nav_menu(
|
||||
"Data",
|
||||
nav_item("What We Track"),
|
||||
nav_item("Sources"),
|
||||
nav_item("Export")
|
||||
),
|
||||
nav_menu(
|
||||
"About",
|
||||
nav_item("Contact Us"),
|
||||
nav_item("Our Studies"),
|
||||
nav_item("MMH/MMP Methodology")
|
||||
)
|
||||
)
|
||||
Reference in New Issue
Block a user