如何使用各种组合在 Shiny 中过滤 data.frame/data.table 中的多个变量

Question

如果我有一个 data.frame/data.table 需要过滤多个列，然后传递给其他计算，我如何过滤数据而不使用if else 创建多个过滤条件组合。

例如，如果我有一个包含 Age、Gender、Ethnicity 的数据，并创建了三个 selectInput()。

我想要实现的是，

1. 如果我从下拉列表中选择年龄：10-19，那么这应该传递给数据并执行DT[Age %in% "10-19"]
2. 类似，如果我选择年龄：10-19 和性别：Female，那么这些应该作为DT[Age %in% "10-19" & Gender %in% "Female"] 传递给数据
3. 如果我取消选择Age，那么数据会返回Gender：Female，比如DT[Gender %in% "Female"]

   如何捕获这些条件，并自动传递给数据过滤器，而无需明确通过这些组合？

   这是一个非工作测试示例

   df <- data.table(AgeGroup = sample(c("0-9", "10-19", "20-29"), 20, replace = TRUE), 
                    Sex = sample(c("Male", "Female"), 20, replace = TRUE))
   
   ui <- fluidPage(
     sidebarLayout(
       sidebarPanel(
         selectInput("AgeGroup", "Age Group", choices = c("", unique(df$AgeGroup))), 
         selectInput("Sex", "Sex", choices = c("", unique(df$Sex)))
       ), 
       mainPanel(
         tableOutput("table")
       )
     )
   )
   
   server <- function(input, output, session) {
     
     # How to modify here so that we don't need to do
     # `if (input$AgeGroup) df[AgeGroup == input$AgeGroup]`
     # consider multiple filters, some filters are selected and some are not. 
     # For example, if there are 5 filters, there would be 2^5 combinations
     
   df_out <- reactive(df)
     
     output$table <- renderTable(df_out())
   }
   
   shinyApp(ui, server)
   
   

Answer 1

我们可以使用| 和& 来构建过滤语句。诀窍是说input$a 要么是""（这意味着返回所有行）或者a 是 input$a。使用多个输入值时，您可以使用 %in% 而不是 ==。

library(shiny)
library(data.table)

df <- data.table(a = c("a", "b", "c"), 
                 b = 1:3)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput("a", "Select A", choices = c("", c("a", "b", "c"))), 
      selectInput("b", "Select B", choices = c("", c(1, 2, 3)))
    ), 
    mainPanel(
      tableOutput("table")
    )
  )
)

server <- function(input, output, session) {
  
  df_out <- reactive(df[(input$a == "" | a == input$a) &
                        (input$b == "" | b == input$b),])
  
  output$table <- renderTable(df_out())
}

shinyApp(ui, server)

一个更具编程性的解决方案是使用 vapply() 并将结果包装在 rowMeans() 中：

library(shiny)
library(data.table)

df <- data.table(a = c("a", "b", "c"), 
                 b = 1:3)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput("a", "Select A", choices = c("", c("a", "b", "c"))), 
      selectInput("b", "Select B", choices = c("", c(1, 2, 3)))
    ), 
    mainPanel(
      tableOutput("table")
    )
  )
)

server <- function(input, output, session) {
  
  
  
  df_out <- reactive({
    
    idx_vec <- vapply(c("a", "b"),
                              FUN.VALUE = logical(nrow(df)),
                              FUN = function(x) {
                                input[[x]] == "" | df[[x]] == input[[x]]
                                })
    
    df[rowMeans(idx_vec) >= 1,]
    
  }) 
    
  
  output$table <- renderTable(df_out())
}

shinyApp(ui, server)