Shiny pickerInput: how to select several choices by clicking one choice (and keep the dropdown open)

Question

I want to make it so that when I select "All_UPPER" in the dropdown, it will automatically select all items in that group.

I got this to work with shinyWidgets::updatePickerInput()

Example:

library(shiny)
library(shinyWidgets)

choices <- c("All_UPPER", "a", "b", "c", "A", "B", "C")

ui <- fluidPage(
  pickerInput("group_select", choices = choices, multiple = TRUE),
  textOutput("testOutput")
)

server <- function(input, output, session) {

  all_upper <- c("A", "B", "C")

  output$testOutput <- renderText({paste(input$test)})

  observeEvent(input$group_select, {
    req(input$group_select)
    if ("All_UPPER" %in% input$group_select) {
      updatePickerInput(session, "group_select", selected =  c(input$group_select, all_upper))
    }

  })

}

shinyApp(ui = ui, server = server)

Desired output is an open dropdown menu with the relevant items picked:

The problem I am having with this is that the dropdown closes when updatePickerInput() runs. I want it to stay open, so that the user can select more items right there if they want to.

How do I prevent the dropdown from closing? (Or how do I automatically open it again?)

Answer 1

I have a hackish workaround for you:

1. Add a JS function which simulates a click.
2. Call this function after you called updatePickerInput
3. As the observer is always firing twice (once when you change the dropdown to All_UPPER and once after the elements got updated via updatePickerInput) you need to add a flag to avoid that the click is triggered twice.

N.B. I tried to make use of the underlying bootstrap API by calling .dropdown("toggle") but this does (for whatever reason) only open an empty list.

library(shiny)
library(shinyWidgets)

choices <- c("All_UPPER", "a", "b", "c", "A", "B", "C")

js <- HTML("
 Shiny.addCustomMessageHandler('toggle_dropdown', function(message) {
   // Just opens an empty list - no idea why
   // $('#' + message.id).parent().find('.dropdown-toggle').dropdown('toggle');
   $('#' + message.id).parent().find('.dropdown-toggle').trigger('click');
 })  
")

ui <- fluidPage(
   tags$head(tags$script(js)),
   pickerInput("group_select", choices = choices, multiple = TRUE),
   textOutput("testOutput")
)

server <- function(input, output, session) {
   changed <- reactiveVal(TRUE)
   
   all_upper <- c("A", "B", "C")
   
   output$testOutput <- renderText({paste(input$test)})
   
   observeEvent(input$group_select, {
      req(input$group_select)
      if ("All_UPPER" %in% input$group_select && changed()) {
         updatePickerInput(session, "group_select", 
                           selected =  c(input$group_select, all_upper))
         session$onFlushed(function() 
            session$sendCustomMessage("toggle_dropdown", list(id = "group_select"))
         )
         changed(FALSE)
      } else {
         changed(TRUE)
      }
      
   })
   
}

shinyApp(ui = ui, server = server)