Tim_Utrecht Tim_Utrecht - 3 months ago 37
R Question

drop-down checkbox input in shiny

Is it possible to have a dropdown list in Shiny where you can select multiple values? I know

selectInput
has the option to set
multiple = T
but I don't like it that all selected option are visible in the screen, especially since I have over 40. The same holds for
checkboxGroupInput()
, which I like more but still all selected values are shown. Isn't it just possible to get a drop-down like the one I copied from Excel below, rather than the examples of Shinys
selectInput
and
checkboxGroupInput()
thereafter?

Excel shiny1 shiny2 shiny3

Answer

Hi I wrote this dropdownButton function once, it create a bootstrap dropdown button (doc here), the results looks like :

dropdown button

Here is the code :

# func --------------------------------------------------------------------

dropdownButton <- function(label = "", status = c("default", "primary", "success", "info", "warning", "danger"), ..., width = NULL) {

  status <- match.arg(status)
  # dropdown button content
  html_ul <- list(
    class = "dropdown-menu",
    style = if (!is.null(width)) 
      paste0("width: ", validateCssUnit(width), ";"),
    lapply(X = list(...), FUN = tags$li, style = "margin-left: 10px; margin-right: 10px;")
  )
  # dropdown button apparence
  html_button <- list(
    class = paste0("btn btn-", status," dropdown-toggle"),
    type = "button", 
    `data-toggle` = "dropdown"
  )
  html_button <- c(html_button, list(label))
  html_button <- c(html_button, list(tags$span(class = "caret")))
  # final result
  tags$div(
    class = "dropdown",
    do.call(tags$button, html_button),
    do.call(tags$ul, html_ul),
    tags$script(
      "$('.dropdown-menu').click(function(e) {
      e.stopPropagation();
});")
  )
  }

And an example :

# app ---------------------------------------------------------------------

library("shiny")
ui <- fluidPage(
  tags$h1("Example dropdown button"),
  br(),
  fluidRow(
    column(
      width = 6,
      dropdownButton(
        label = "Check some boxes", status = "default", width = 80,
        checkboxGroupInput(inputId = "check1", label = "Choose", choices = paste(1:26, ") Choice ", LETTERS))
      ),
      verbatimTextOutput(outputId = "res1")
    ),
    column(
      width = 6,
      dropdownButton(
        label = "Check some boxes", status = "default", width = 80,
        actionButton(inputId = "a2z", label = "Sort A to Z", icon = icon("sort-alpha-asc")),
        actionButton(inputId = "z2a", label = "Sort Z to A", icon = icon("sort-alpha-desc")),
        br(),
        actionButton(inputId = "all", label = "(Un)select all"),
        checkboxGroupInput(inputId = "check2", label = "Choose", choices = paste(1:26, ") Choice ", LETTERS))
      ),
      verbatimTextOutput(outputId = "res2")
    )
  )
)
server <- function(input, output, session) {
  output$res1 <- renderPrint({
    input$check1
  })

  # Sorting asc
  observeEvent(input$a2z, {
    updateCheckboxGroupInput(
      session = session, inputId = "check2", choices = paste(1:26, ") Choice ", LETTERS), selected = input$check2
    )
  })
  # Sorting desc
  observeEvent(input$z2a, {
    updateCheckboxGroupInput(
      session = session, inputId = "check2", choices = paste(26:1, ") Choice ", rev(LETTERS)), selected = input$check2
    )
  })
  output$res2 <- renderPrint({
    input$check2
  })
  # Select all / Unselect all
  observeEvent(input$all, {
    if (is.null(input$check2)) {
      updateCheckboxGroupInput(
        session = session, inputId = "check2", selected = paste(1:26, ") Choice ", LETTERS)
      )
    } else {
      updateCheckboxGroupInput(
        session = session, inputId = "check2", selected = ""
      )
    }
  })
}
shinyApp(ui = ui, server = server)

In bonus I put the ascending/descending sorting thingy in the second dropdown buttons.