如何在 Shiny 应用程序中编写模块化或更多 DRY selectizeInput 检查空值/全部

Question

Assume we have a shiny app that utilizes several selectizeInput controls with ( multiple = TRUE ). I would like to have a reactive table that filters for those selected choices, but also does not filter when "nothing" is selected. I know I could create an "All" bucket/choice, but I would prefer to just leave this blank. I am able to do this with a simple is.null pattern of if (.is.null(input$something) column %in% input$something else TRUE , but this is not very DRY once I have more inputs.

Is there a way to make this code more dry? Or even just shorten this code via a function? Or are shiny modules the way to go?

library(shiny)
library(tidyverse)

df_test <- tibble::tribble(
    ~ Region, ~ Category,
    "West",       "A",
    "West",       "A",
    "West",       "B",
    "East",       "D",
    "East",       "E",
    "North",       "A",
    "North",       "B",
    "North",       "C"
) %>% 
    mutate_all(as.factor)

ui <- fluidPage(
    selectizeInput(
        "region", "Select region(s):", 
        choices = levels(df_test$Region),
        multiple = TRUE
    ),
    selectizeInput(
        "category", "Select category/categories:",
        choices = levels(df_test$Category),
        multiple = TRUE
    ),
    tableOutput("table")
)


server <- function(input, output, session) {
    output$table <- renderTable(
        df_test %>%
            filter(
                # This pattern works, but is not very DRY and there are many 
                # more inputs...
                if (!is.null(input$region)) Region %in% input$region else TRUE,
                if (!is.null(input$category)) Category %in% input$category else TRUE
            )
    )
}

shinyApp(ui, server)

Answer 1

I think if it is especially for dplyr , then the easiest way is to write a custom filter function. Here is one proposal, however so far it only works for one filter option at a time. I have to think a bit more how to generalise it.

library(dplyr)

filter_shiny <- function(.data, var, input, ...) {
  if (is.null(input)) {
    dplyr::filter(.data, TRUE, ...)
  } else {
    dplyr::filter(.data, {{var}} %in% input, ...)
  }
}

test_input <- "virginica"

iris %>% 
  filter_shiny(Species, test_input) %>% 
  head()
#>   Sepal.Length Sepal.Width Petal.Length Petal.Width   Species
#> 1          6.3         3.3          6.0         2.5 virginica
#> 2          5.8         2.7          5.1         1.9 virginica
#> 3          7.1         3.0          5.9         2.1 virginica
#> 4          6.3         2.9          5.6         1.8 virginica
#> 5          6.5         3.0          5.8         2.2 virginica
#> 6          7.6         3.0          6.6         2.1 virginica

test_input <- NULL

iris %>% 
  filter_shiny(Species, test_input) %>% 
  head()
#>   Sepal.Length Sepal.Width Petal.Length Petal.Width Species
#> 1          5.1         3.5          1.4         0.2  setosa
#> 2          4.9         3.0          1.4         0.2  setosa
#> 3          4.7         3.2          1.3         0.2  setosa
#> 4          4.6         3.1          1.5         0.2  setosa
#> 5          5.0         3.6          1.4         0.2  setosa
#> 6          5.4         3.9          1.7         0.4  setosa

---

Edit

I've tried to come up with a function that takes an arbitrary amount of arguments. I'm a beginner in metaprogramming, so for now I've built the filtering function by myself instead of manipulating the input for dplyr::filter:

library(dplyr)

# this function takes pairs of input:
# 1. the variable
# 2. the filter condition
#
# example:
# iris %>% 
#   filter_shiny_2(Species, c("versicolor", "virginica"))
filter_shiny_2 <- function(.data, ...) {
  
  # capture the user provided input
  vars <- rlang::enquos(...)
  
  if (length(vars) %% 2 != 0) stop("You need to provide pairs of variables and filter conditions.")
  
  # discard all filter conditions where the condition is NULL
  index_delete <- unlist(lapply(seq(from = 2, to = length(vars), by = 2), function(i) {
    is.null(rlang::eval_tidy(vars[[i]]))
  }))
  
  # if the second input gets deleted, then also the associated variable
  # therefore expand the index
  index_delete <- rep(index_delete, each = 2)
  vars[index_delete] <- NULL
  
  if (length(vars) > 0) {
    # do the filtering for every supplied variable
    filter_index <- TRUE
    for (j in seq(from = 1, to = length(vars) - 1, by = 2)) {
      # generate the index which rows fullfill the filter condition
      # rlang::eval_tidy uses the provided .data to get the values of the variable
      # use the corresponding values for filtering in rhs of %in%
      filter_index <- (rlang::eval_tidy(vars[[j]], data = .data) %in%
                         rlang::eval_tidy(vars[[j + 1]])) & filter_index
      
    }
    .data[filter_index, ]
    
  } else {
    .data
  }
}

test_data <- data.frame(type = rep(c("mac", "windows", "linux"), each = 4),
                        used = rep(c("new", "used"), each = 2))

test_var1 <- c("mac", "linux")
test_var2 <- c("new")

test_data %>% 
  filter_shiny_2(type, test_var1,
                 used, test_var2)
#>     type used
#> 1    mac  new
#> 2    mac  new
#> 9  linux  new
#> 10 linux  new

test_var2 <- NULL

test_data %>% 
  filter_shiny_2(type, test_var1,
                 used, test_var2)
#>     type used
#> 1    mac  new
#> 2    mac  new
#> 3    mac used
#> 4    mac used
#> 9  linux  new
#> 10 linux  new
#> 11 linux used
#> 12 linux used

^{Created on 2020-09-02 by the reprex package (v0.3.0)}