Search code examples
rshinyshinywidgetspickerinput

Is there a way to select an entire group of choices on a pickerInput from shinyWidgets?


Here is a simple reproducible example:

library(shiny)
library(shinyWidgets)

ui <- fluidPage(
    pickerInput("test",choices=list("A"=c(1,2,3,4,5),"B"=c(6,7,8,9,10)),multiple=TRUE),
    textOutput("testOutput")
)

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

shinyApp(ui = ui, server = server)

What I'd like is to click A and have the pickerInput automatically select 1,2,3,4 and 5. Or if we click B, it automatically selects 6,7,8,9, and 10.

Desired output after clicking "A":

enter image description here

Any help is appreciated, thanks.


Solution

  • You can use some JS to get the result:

    library(shiny)
    library(shinyWidgets)
    
    js <- HTML("
    $(function() {
      let observer = new MutationObserver(callback);
    
      function clickHandler(evt) {
        Shiny.setInputValue('group_select', $(this).children('span').text());
      }
    
      function callback(mutations) {
        for (let mutation of mutations) {
          if (mutation.type === 'childList') {
            $('.dropdown-header').on('click', clickHandler).css('cursor', 'pointer');
            
          }
        }
      }
    
      let options = {
        childList: true,
      };
    
      observer.observe($('.inner')[0], options);
    })
    ")
    
    choices <- list("A" = c(1, 2, 3, 4, 5), "B" = c(6, 7, 8, 9, 10))
    
    ui <- fluidPage(
       tags$head(tags$script(js)),
       pickerInput("test", choices = choices, multiple = TRUE),
       textOutput("testOutput")
    )
    
    server <- function(input, output, session) {
       output$testOutput <- renderText({paste(input$test)})
       
       observeEvent(input$group_select, {
          req(input$group_select)
          updatePickerInput(session, "test", selected = choices[[input$group_select]])
       })
    }
    
    shinyApp(ui = ui, server = server)
    

    Explanation

    Idea is that you set an onClick event for the header line, where you set an input variable, upon which you can react in Shiny.

    The whole MutationObserver construct is a crude workaround, because I could not get a (delegated) event listener working.

    What I observed is that (not bring an JavaScriptspecialist):

    • The content of the dropdown is not generated before the first click. Hence, a direct event listener like $('.dropdown-header').on() woudl not work, because the element is not yet existing.
    • Event delegation a la $(document).on('click', '.dropdown-header', ...) did not work either. I assume that somewhere there is a stopPropagation preventing that the event is bubbling up.

    Thus, I used the MutationObserver to add the ('.drodown-header') listener the moment it is created. Not the most beautiful nor a resource preserving solution, but at least a working one. Maybe, you can find out how to properly set the event listener w/o the MutationObsever.


    Update

    If you want to keep all existing selections, you would change the observeEvent as follows:

    observeEvent(input$group_select, {
       req(input$group_select)
       sel <- union(input$test, choices[[input$group_select]])
       updatePickerInput(session, "test", selected = sel)
    })
    
    

    More Background 2022

    As this answer was referenced by another question and there was a question in the comments, why we need the MutationObserver in the first place, I finally did look up the source code of the input bootstrap-select.js and my intuition was right, clicks on the .dropdown-header are actively prevented from bubbling up:

    this.$menuInner.on('click', '.divider, .dropdown-header', function (e) {
      e.preventDefault();
      e.stopPropagation();
      if (that.options.liveSearch) {
        that.$searchbox.trigger('focus');
      } else {
        that.$button.trigger('focus');
      }
    });