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?)
I have a hackish workaround for you:
updatePickerInput
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)