闪亮的用户驱动过滤器逻辑

Question

我正在创建一个 Rshiny 应用程序，让用户可以选择使用与过滤器行对应的复选框来过滤数据框。用户还可以选择通过单选按钮来控制过滤器逻辑以使用“AND”逻辑或“OR”逻辑。我创建了一个使用字母 x-z 作为过滤器选项的最小可重现示例，其中行具有 x、y 和 z 的所有可能组合。然而，复选框将只有 x、y 或 z 选项。如果用户选择了 OR 逻辑和所有字母，则每一行都将可见。如果用户选择了 OR 逻辑并且只有“x”和“y”，则只会显示行 x、y、xy、xyz、xz、yz。如果用户选择了相同的“x”和“y”，但选择了 AND 逻辑，则只会显示“xy”和“xyz”行。

我在为此创建过滤逻辑时遇到困难，我们将不胜感激。实际的过滤器有大约 10 个独特的选择，随着数据帧复杂性的增加，这些选择可能会增加，我想让过滤器尽可能灵活，而不是对每个可能的组合进行硬编码。

一个可重现的例子：

df <- data.frame(value = 1:7,
        filter = c("x","y","z","xy", "xz", "yz", "xyz"))

library(shiny)

ui <- fluidPage(
  title = "Example",
  sidebarLayout(
    sidebarPanel(
      radioButtons("andOR", 
                   label = "Filters Logic:",
                   c("OR", "AND"),
                   inline = TRUE),
        checkboxGroupInput("filter", "Filter Options:",
                           letters[24:26], selected = letters[24:26])
    ),
    mainPanel(
      DT::dataTableOutput("mytable1")
    )
  )
)

server <- function(input, output) {
  
  #filtering logic
  filteredData <- reactive({
    if(input$andOR == 'OR') {
        df %>%
          filter()
    } else {
      df %>%
        filter()
    }
  })

  
  output$mytable1 <- DT::renderDataTable({
    DT::datatable(filteredData())
  })
  
}

shinyApp(ui, server)

Answer 1

这个解决方案可能有点冗长，但它以一种非常动态的方式完成了工作。为了处理 AND 逻辑，辅助函数 multi_filter 使用一些整洁的 eval 东西来生成 n 个过滤器表达式。 OR 逻辑类似于给出的其他答案，使用str_detect 和"|"。希望那些遇到这个答案的人至少会发现使用整洁的 eval 代码信息量很大。

library(shiny)
library(tidyverse)

df <- tibble(
  value = 1:7,
  filter = c("x","y","z","xy", "xz", "yz", "xyz")
  )

# helper function to create multiple filter expressions
# .filters will be input$filter

multi_filter <- function(.data, .col, .filters) {
  expressions <- map(.filters, ~ quo(str_detect({{ .col }}, !!.x)))
  filter(.data, !!!expressions)
}

ui <- fluidPage(
  title = "Example",
  sidebarLayout(
    sidebarPanel(
      radioButtons("andOR", 
                   label = "Filters Logic:",
                   c("OR", "AND"),
                   inline = TRUE),
      checkboxGroupInput("filter", "Filter Options:",
                         letters[24:26], selected = letters[24:26])
    ),
    mainPanel(
      DT::dataTableOutput("mytable1")
    )
  )
)

server <- function(input, output) {
  
  filter_inputs <- reactive({
    if (length(input$filter) == 0) {
      return('')
    } else if (length(input$filter) == 1) {
      return(input$filter)
    } else {
      return(input$filter %>% str_flatten(collapse = '|'))
    }
  })
  
  filter_negate <- reactive({
    if (length(input$filter) == 0) {
      return(TRUE)
    } else {
      return(FALSE)
    }
  })
  
  # #filtering logic
  filteredData <- reactive({
    if(input$andOR == 'OR') {
      df %>% filter(str_detect(filter, filter_inputs(), negate = filter_negate()))
    } else {
      df %>% multi_filter(.col = filter, .filters = input$filter)
    }
  })

  
  output$mytable1 <- DT::renderDataTable({
    DT::datatable(filteredData())
  })
  
}

shinyApp(ui, server)

Answer 2

这个解决方案似乎效果最好。谢谢to this answer 和this answer in the comments 的帮助。

  #filtering logic
  library(data.table)
  filteredData <- reactive({
    if(length(input$filter)==0){
      df[0,]
    } else if(input$andOR == 'OR') {
       df %>%
        filter(filter %like% paste(input$filter,collapse = '|'))
    } else {
      df %>%
        filter(grepl(paste(sprintf("(?=.*%s)", input$filter), collapse=""), df$filter, perl=TRUE))
    }
  })

Answer 3

这是一个解决方案 - 不是很优雅，但也许它会给你一些想法。

 server <- function(input, output) {

     #filtering logic
     filteredData <- reactive({
         if(is.null(input$filter)){
             df
         }
         else if(input$andOR == 'OR') {
             df %>% filter(stringr::str_detect(filter, input$filter))
         } else {
             for(x in letters[24:26]){
                 print(x)
                 if(x %in% input$filter){
                     df[[x]] <- stringr::str_detect(df$filter, x)
                 } else {
                      df[[x]] <- TRUE
                 }
             }
        
             df %>% filter(x & y & z) %>% select(-x, -y, -z)
         }
     })


     output$mytable1 <- DT::renderDataTable({
         DT::datatable(filteredData())
     })

 }