shiny dropdown button error

Question

I have been using the dropdown function found here a ton in my shiny apps. However, I noticed unusual behavior when I try to use it in an application that uses navbarMenu/tabPanel ui layouts. The app below will not allow you to switch from one tab to another once you have selected the tab that contains the dropdown.

library(shiny)

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();
});"
        )
    )
}


ui <- fluidPage(
    navbarPage("This is an App", 
               tabPanel("Start Here - Page 0"), 
               navbarMenu("This is Page 1", 
                          tabPanel("p1 t1", 
                                   uiOutput("p1t1_out"), 
                                   checkboxInput("test", "here")), 
                          tabPanel("p2 t2")), 
               navbarMenu("This is Page 2",
                          tabPanel("p2 t1"), 
                          tabPanel("p2 t2"))))


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

    output$p1t1_out <- renderUI({
        dropdownButton(
            label = "Select Here",
            status = "default",
            width = 300,
            actionButton(inputId = "p1t1_all", label = "(Un)select All"),
            checkboxGroupInput(
                inputId = "p1t1_choice",
                label = "select vars",
                choices = as.list(names(mtcars)),
                selected = as.list(names(mtcars))
            )
        )
    })
    # Select all / Unselect all 
    observeEvent(input$p1t1_all, {
        if (is.null(input$p1t1_choice)) {
            updateCheckboxGroupInput(
                session = session,
                inputId = "p1t1_choice",
                selected = as.list(names(mtcars))
            )
        } else {
            updateCheckboxGroupInput(
                session = session,
                inputId = "p1t1_choice",
                selected = ""
            )
        }
    })
}

shinyApp(ui, server)

Ok, I'm pretty sure anyone who fully reads the [question I have already linked to in my question](https://stackoverflow.com/questions/34530142/drop-down-checkbox-input-in-shiny) would know this, but that function is now part of the `shinyWidgets` package. Using the function as part of that package solves this issues. I'll leave this up here in case anyone else fails to read the complete response. — Nick Criswell, Nov 24 '17 at 18:16

score 0 · Accepted Answer · answered Nov 24 '17 at 18:26

Per my comment, this can be accomplished simply by loading the shinyWidgets package and then adding circle = FALSE if you want your button to be labeled.

library(shiny)
library(shinyWidgets)

ui <- fluidPage(
    navbarPage("This is an App", 
               tabPanel("Start Here - Page 0"), 
               navbarMenu("This is Page 1", 
                          tabPanel("p1 t1", 
                                   uiOutput("p1t1_out"), 
                                   checkboxInput("test", "here")), 
                          tabPanel("p2 t2")), 
               navbarMenu("This is Page 2",
                          tabPanel("p2 t1"), 
                          tabPanel("p2 t2"))))


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

    output$p1t1_out <- renderUI({
        dropdownButton(
            circle = FALSE,
            label = "Select Here",
            status = "default",
            width = 300,
            actionButton(inputId = "p1t1_all", label = "(Un)select All"),
            checkboxGroupInput(
                inputId = "p1t1_choice",
                label = "select vars",
                choices = as.list(names(mtcars)),
                selected = as.list(names(mtcars))
            )
        )
    })
    # Select all / Unselect all 
    observeEvent(input$p1t1_all, {
        if (is.null(input$p1t1_choice)) {
            updateCheckboxGroupInput(
                session = session,
                inputId = "p1t1_choice",
                selected = as.list(names(mtcars))
            )
        } else {
            updateCheckboxGroupInput(
                session = session,
                inputId = "p1t1_choice",
                selected = ""
            )
        }
    })
}

shinyApp(ui, server)

shiny dropdown button error

1 Answers1