add input filtering to coverage table

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(
+      "<span class=\"badge bg-primary\">HURDAT2</span>",
+      ifelse(
+        as.logical(has_fatality_data),
+        "<span class=\"badge bg-danger\">Fatality</span>",
+        ""
+      ),
+      ifelse(
+        as.logical(has_cost_data),
+        "<span class=\"badge bg-success\">Cost</span>",
+        ""
+      )
+    ))
+  ) %>%
+  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)
 })

app/server.R

@@ -4,36 +4,78 @@ server <- function(input, output, session) {
       addProviderTiles("Stadia.AlidadeSmooth")
   })
 
-  storm_coverage <- get_storm_data_coverage() %>%
+  updateSliderInput(
-    mutate(
+    session,
-      data = trimws(paste(
+    "dt_year_filter",
-        "<span class=\"badge bg-primary\">HURDAT2</span>",
+    min = dt_yr_range[1],
-        ifelse(
+    max = dt_yr_range[2],
-          as.logical(has_fatality_data),
+    value = dt_yr_range
-          "<span class=\"badge bg-danger\">Fatality</span>",
+  )
-          ""
+
-        ),
+  search_debounced <- debounce(reactive(input$table_search), 200)
-        ifelse(
+
-          as.logical(has_cost_data),
+  filtered_storms <- reactive({
-          "<span class=\"badge bg-success\">Cost</span>",
+    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)) %>%
+    mmh_r <- input$dt_mmh_filter
-    select(
+    if (!is.null(mmh_r)) {
-      hurdatid,
+      min_mmh <- mmh_r[1]
-      storm_name,
+      max_mmh <- mmh_r[2]
-      storm_year,
+      data <- data %>%
-      data,
+        filter(
-      mmh,
+          (is.na(mmh) & (is.na(min_mmh) | min_mmh == 0)) |
-      mmp,
+            (!is.na(mmh) &
-      total_direct_deaths,
+              (is.na(min_mmh) | mmh >= min_mmh) &
-      total_observations,
+              (is.na(max_mmh) | mmh <= max_mmh))
-      max_category,
+        )
-      max_windspeed,
+    }
-      min_pressure
+
-    )
+    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,
+        info = T,
-        lengthChange = F
+        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({

app/ui.R

@@ -48,9 +48,94 @@ ui <- page_navbar(
     layout_columns(
       col_widths = c(8, 4),
       card(
-        card_body(
+        div(
-          DTOutput("storm_coverage_table")
+          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,