From a2d0b7830ac65b1d467733e3ddab4f4b3e657241 Mon Sep 17 00:00:00 2001 From: dylanbenzi Date: Thu, 9 Apr 2026 22:44:39 -0400 Subject: [PATCH] add input filtering to coverage table --- app/global.R | 38 ++++++++++++++++++ app/server.R | 110 +++++++++++++++++++++++++++++++++++---------------- app/ui.R | 91 ++++++++++++++++++++++++++++++++++++++++-- 3 files changed, 202 insertions(+), 37 deletions(-) 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,