diff --git a/app/global.R b/app/global.R
index 03970cd..1a73ad6 100644
--- a/app/global.R
+++ b/app/global.R
@@ -46,6 +46,44 @@ all_conus_landfalls <- get_all_conus_landfalls()
all_lf_type_storms <- get_all_lf_type_landfalls()
+storm_coverage <- get_storm_data_coverage() %>%
+ mutate(
+ data = trimws(paste(
+ "HURDAT2",
+ ifelse(
+ as.logical(has_fatality_data),
+ "Fatality",
+ ""
+ ),
+ ifelse(
+ as.logical(has_cost_data),
+ "Cost",
+ ""
+ )
+ ))
+ ) %>%
+ mutate(total_direct_deaths = as.integer(total_direct_deaths)) %>%
+ select(
+ hurdatid,
+ storm_name,
+ storm_year,
+ data,
+ mmh,
+ mmp,
+ total_direct_deaths,
+ total_observations,
+ max_category,
+ max_windspeed,
+ min_pressure,
+ has_fatality_data,
+ has_cost_data
+ )
+
+dt_yr_range <- range(storm_coverage$storm_year, na.rm = TRUE)
+dt_death_max <- max(storm_coverage$total_direct_deaths, na.rm = TRUE)
+dt_mmh_max <- max(storm_coverage$mmh, na.rm = TRUE)
+dt_mmp_max <- max(storm_coverage$mmp, na.rm = TRUE)
+
onStop(function() {
poolClose(con)
})
diff --git a/app/server.R b/app/server.R
index 1dcb2c0..e0a125b 100644
--- a/app/server.R
+++ b/app/server.R
@@ -4,36 +4,78 @@ server <- function(input, output, session) {
addProviderTiles("Stadia.AlidadeSmooth")
})
- storm_coverage <- get_storm_data_coverage() %>%
- mutate(
- data = trimws(paste(
- "HURDAT2",
- ifelse(
- as.logical(has_fatality_data),
- "Fatality",
- ""
- ),
- ifelse(
- as.logical(has_cost_data),
- "Cost",
- ""
+ updateSliderInput(
+ session,
+ "dt_year_filter",
+ min = dt_yr_range[1],
+ max = dt_yr_range[2],
+ value = dt_yr_range
+ )
+
+ search_debounced <- debounce(reactive(input$table_search), 200)
+
+ filtered_storms <- reactive({
+ data <- storm_coverage
+
+ search <- search_debounced()
+ if (!is.null(search) && nzchar(trimws(search))) {
+ data <- data %>%
+ filter(grepl(trimws(search), storm_name, ignore.case = TRUE))
+ }
+
+ if (isTruthy(input$filter_cost)) {
+ data <- data %>% filter(as.logical(has_cost_data))
+ }
+ if (isTruthy(input$filter_fatality)) {
+ data <- data %>% filter(as.logical(has_fatality_data))
+ }
+
+ yr <- input$dt_year_filter
+ if (!is.null(yr)) {
+ data <- data %>% filter(storm_year >= yr[1], storm_year <= yr[2])
+ }
+
+ deaths <- input$dt_deaths_filter
+ if (!is.null(deaths)) {
+ min_d <- deaths[1]
+ max_d <- deaths[2]
+ data <- data %>%
+ filter(
+ (is.na(total_direct_deaths) & (is.na(min_d) | min_d == 0)) |
+ (!is.na(total_direct_deaths) &
+ (is.na(min_d) | total_direct_deaths >= min_d) &
+ (is.na(max_d) | total_direct_deaths <= max_d))
)
- ))
- ) %>%
- mutate(total_direct_deaths = as.integer(total_direct_deaths)) %>%
- select(
- hurdatid,
- storm_name,
- storm_year,
- data,
- mmh,
- mmp,
- total_direct_deaths,
- total_observations,
- max_category,
- max_windspeed,
- min_pressure
- )
+ }
+
+ mmh_r <- input$dt_mmh_filter
+ if (!is.null(mmh_r)) {
+ min_mmh <- mmh_r[1]
+ max_mmh <- mmh_r[2]
+ data <- data %>%
+ filter(
+ (is.na(mmh) & (is.na(min_mmh) | min_mmh == 0)) |
+ (!is.na(mmh) &
+ (is.na(min_mmh) | mmh >= min_mmh) &
+ (is.na(max_mmh) | mmh <= max_mmh))
+ )
+ }
+
+ mmp_r <- input$dt_mmp_filter
+ if (!is.null(mmp_r)) {
+ min_mmp <- mmp_r[1]
+ max_mmp <- mmp_r[2]
+ data <- data %>%
+ filter(
+ (is.na(mmp) & (is.na(min_mmp) | min_mmp == 0)) |
+ (!is.na(mmp) &
+ (is.na(min_mmp) | mmp >= min_mmp) &
+ (is.na(max_mmp) | mmp <= max_mmp))
+ )
+ }
+
+ data
+ })
output$dt_storm_badges <- renderUI({
div(HTML(dt_storm_selected()$data))
@@ -41,7 +83,7 @@ server <- function(input, output, session) {
output$storm_coverage_table <- renderDT({
datatable(
- storm_coverage %>%
+ filtered_storms() %>%
select(
hurdatid,
storm_name,
@@ -65,12 +107,12 @@ server <- function(input, output, session) {
),
selection = "single",
options = list(
- pageLength = 1000,
order = list(4, 'desc'),
searching = F,
paging = F,
- info = F,
- lengthChange = F
+ info = T,
+ lengthChange = F,
+ dom = "ti"
)
) %>%
formatCurrency(c("mmh", "mmp"), "$", digits = 0)
@@ -78,7 +120,7 @@ server <- function(input, output, session) {
dt_storm_selected <- reactive({
req(input$storm_coverage_table_rows_selected)
- storm_coverage[input$storm_coverage_table_rows_selected, ]
+ filtered_storms()[input$storm_coverage_table_rows_selected, ]
})
output$dt_max_category <- renderText({
diff --git a/app/ui.R b/app/ui.R
index eee874f..aaaaa6f 100644
--- a/app/ui.R
+++ b/app/ui.R
@@ -48,9 +48,94 @@ ui <- page_navbar(
layout_columns(
col_widths = c(8, 4),
card(
- card_body(
- DTOutput("storm_coverage_table")
- )
+ div(
+ class = "px-1 pt-1",
+ layout_columns(
+ col_widths = c(6, 6),
+ textInput(
+ "table_search",
+ "Storm Search",
+ placeholder = "Search storm name...",
+ width = "100%"
+ ),
+ div(
+ tags$label(class = "form-label", "Data Availability"),
+ layout_columns(
+ col_widths = c(4, 4, 4),
+ tags$div(
+ class = "btn-group w-100",
+ role = "group",
+ tags$button(
+ class = "btn btn-primary w-100",
+ style = "pointer-events: none;",
+ "HURDAT2"
+ )
+ ),
+ checkboxGroupButtons(
+ "filter_cost",
+ label = NULL,
+ choices = "Cost",
+ selected = character(0),
+ status = "outline-success",
+ justified = TRUE,
+ width = "100%"
+ ),
+ checkboxGroupButtons(
+ "filter_fatality",
+ label = NULL,
+ choices = "Fatality",
+ selected = character(0),
+ status = "outline-danger",
+ justified = TRUE,
+ width = "100%"
+ )
+ )
+ )
+ ),
+ layout_columns(
+ col_widths = c(6, 6),
+ sliderInput(
+ "dt_year_filter",
+ "Year",
+ min = 1900,
+ max = 2024,
+ value = c(1900, 2024),
+ sep = "",
+ step = 1,
+ ticks = FALSE,
+ width = "100%"
+ ),
+ numericRangeInput(
+ "dt_deaths_filter",
+ "Direct Deaths",
+ value = c(0, dt_death_max),
+ min = 0,
+ separator = "–",
+ width = "100%"
+ )
+ ),
+ layout_columns(
+ col_widths = c(6, 6),
+ numericRangeInput(
+ "dt_mmh_filter",
+ "MMH ($)",
+ value = c(0, round(dt_mmh_max, digits = 0)),
+ min = 0,
+ separator = "–",
+ width = "100%"
+ ),
+ numericRangeInput(
+ "dt_mmp_filter",
+ "MMP ($)",
+ value = c(0, round(dt_mmp_max, digits = 0)),
+ min = 0,
+ separator = "–",
+ width = "100%"
+ )
+ )
+ ),
+ hr(class = "m-0"),
+ DTOutput("storm_coverage_table")
),
layout_columns(
col_widths = 12,