R shinyWidgets pickerInput: how to not filter data frame when select all

Question

I have the following app to plot a histogram based on the input from pickerInput. Imagine that the data frame is very big, and if I select all, it takes a while to pass all the choices into the filter statement. Is there a select-all flag that can do something like: if pickerinput$select_all is true then x = df; else x = df %>% filter( ID %in% input$id). Thank you!

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

One simple solution if to do it in the server function where you check if all the columns are selected and only then choose to filter or not filter.

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)

The Alternative is doing it exactly like how you wanted to. We directly detect if the user has clicked on Select All or Deselect All. This requires us to attach an onclick listener and ask the browser to send a message to the server through 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)