add input filtering to coverage table

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(
-        "<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>",
-          ""
+  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({