R shinyWidgets pickerInput：全选时如何不过滤数据框

Question

我有以下应用程序可以根据 pickerInput 的输入绘制直方图。想象一下，数据框很大，如果我全选的话，需要一段时间才能把所有的选项都传到过滤器语句中。是否有一个全选标志可以执行以下操作： 如果 pickerinput$select_all 为真，则 x = df;否则 x = df %>% 过滤器（ID %in% input$id）。 谢谢！

library("shiny")
library("dplyr")
library("shinyWidgets")

mychoices <- c("A", "B", "C", "D", "E","F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T",
           "U", "V", "W", "X", "Y", "Z")
df <- data.frame("ID" = mychoices, "invoice" = runif(26, 100, 200))

ui <- fluidPage(
 sidebarLayout(
  sidebarPanel(
    pickerInput(
      inputId = "id", label = "Choices :",
      choices = mychoices,
      options = list('actions-box' = TRUE),
      multiple = TRUE
    )
 ),
mainPanel(
    plotOutput("test")        
  )
 )
)

server <- function(input, output) {
  output$test <- renderPlot({
    x = df %>% filter( ID %in% input$id)
    ggplot(data = x, aes(invoice)) + geom_histogram(binwidth=30, alpha=0.6)
  })
}

shinyApp(ui = ui, server = server)

Answer 1

一个简单的解决方案是在服务器函数中检查是否选择了所有列，然后才选择过滤或不过滤。

library("shiny")
library("dplyr")
library("shinyWidgets")

mychoices <- c("A", "B", "C", "D", "E","F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T",
           "U", "V", "W", "X", "Y", "Z")
df <- data.frame("ID" = mychoices, "invoice" = runif(26, 100, 200))

ui <- fluidPage(
 sidebarLayout(
  sidebarPanel(
    pickerInput(
      inputId = "id", label = "Choices :",
      choices = mychoices,
      options = list('actions-box' = TRUE),
      multiple = TRUE
    )
 ),
mainPanel(
    plotOutput("test")        
  )
 )
)



server <- function(input, output) {

  output$test <- renderPlot({

    if(all(mychoices %in% input$id)){
      x = df
    }else{
      x = df %>% filter( ID %in% input$id)
    }
    ggplot(data = x, aes(invoice)) + geom_histogram(binwidth=30, alpha=0.6)
  })
}

shinyApp(ui = ui, server = server)

替代方案完全按照您的意愿行事。我们直接检测用户是否点击了Select All 或Deselect All。这需要我们附加一个 onclick 监听器，并要求浏览器通过 javascript 向服务器发送消息。

library("shiny")
library("dplyr")
library("shinyWidgets")

mychoices <- c("A", "B", "C", "D", "E","F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T",
               "U", "V", "W", "X", "Y", "Z")
df <- data.frame("ID" = mychoices, "invoice" = runif(26, 100, 200))

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      pickerInput(
        inputId = "id", label = "Choices :",
        choices = mychoices,
        options = list('actions-box' = TRUE),
        multiple = TRUE
      )
    ),
    mainPanel(
      plotOutput("test")        
    )
  ),
  tags$script(HTML("
                window.onload = function(){ 
                  var select_all = document.getElementsByClassName('bs-select-all');
                  select_all = select_all[0];
                  select_all.onclick = function() {
                       Shiny.onInputChange('select_all',true);
                  }; 

                 var deselect_all = document.getElementsByClassName('bs-deselect-all');
                  deselect_all = deselect_all[0];
                  deselect_all.onclick = function() {
                       Shiny.onInputChange('select_all',false);
                  }; 

                  var run_once = true;

                  if(run_once){
                   var select_input = document.getElementsByClassName('filter-option');
                   select_input = select_input[0];
                   select_input.onclick = function() {
                   Shiny.onInputChange('select_all',false);
                   run_once =  false;
                   };
                  }

                }
                   "))
)

server <- function(input, output) {

  output$test <- renderPlot({

    if(length(input$select_all) != 0){
      if(input$select_all){
        x = df
      }else{
        x = df %>% filter( ID %in% input$id)
      }
      ggplot(data = x, aes(invoice)) + geom_histogram(binwidth=30, alpha=0.6)
    }


  })
}

shinyApp(ui = ui, server = server)