Search code examples
rshinyshinydashboardshinyapps

shinydashboard: Lost `tabItem` responsiveness when including inputs in `menuItem`


I got a dashboard where the tabItem that shows in the dashboardBody is dependant on the menuItem selected on the dashboardMenu, like this:

library(shiny)
library(shinydashboard)

ui <- dashboardPage(dashboardHeader(title = "This works"),
                    dashboardSidebar(
                      sidebarMenu(
                        menuItem("item 1", tabName = "item1", icon = icon("th-list")),
                        menuItem("item 2", tabName = "item2", icon = icon("list-alt"))
                                 )
                      ),
                    dashboardBody(
                      tabItems(
                        tabItem(tabName = "item1",
                                tabsetPanel(id = "tabs1",
                                            tabPanel("Tab1", plotOutput("1")),
                                            tabPanel("Tab2", plotOutput("2"))

                                )),
                        tabItem(tabName = "item2",
                                tabsetPanel(id = "tabs2",
                                            tabPanel("Tab3", plotOutput("3")),
                                            tabPanel("Tab4", plotOutput("4"))
                                            )
                                )
                        )
                      )
                    )

server <- function(input, output) {}

shinyApp(ui, server)

However, as soon as I include an input in menuItem, this response is lost:

 ui <- dashboardPage(dashboardHeader(title = "This doesn't work"),
                    dashboardSidebar(
                      sidebarMenu(
                        menuItem("item 1", tabName = "item1", icon = icon("th-list"),
                                 checkboxInput("check", label = "check")),
                        menuItem("item 2", tabName = "item2", icon = icon("list-alt"))
                                 )
                      ),
                    dashboardBody(
                      tabItems(
                        tabItem(tabName = "item1",
                                tabsetPanel(id = "tabs1",
                                            tabPanel("Tab1", plotOutput("1")),
                                            tabPanel("Tab2", plotOutput("2"))

                                )),
                        tabItem(tabName = "item2",
                                tabsetPanel(id = "tabs2",
                                            tabPanel("Tab3", plotOutput("3")),
                                            tabPanel("Tab4", plotOutput("4"))
                                            )
                                )
                        )
                      )
                    )

server <- function(input, output) {}

shinyApp(ui, server)

Solution

  • Applying this answer to your example works. Here's the solution:

    convertMenuItem <- function(mi,tabName) {
      mi$children[[1]]$attribs['data-toggle']="tab"
      mi$children[[1]]$attribs['data-value'] = tabName
      mi
    }
    
    ui <- dashboardPage(dashboardHeader(title = "This works now"),
                        dashboardSidebar(
                          sidebarMenu(
                            convertMenuItem(menuItem("item 1", tabName = "item1", icon = icon("th-list"),
                                                     checkboxInput("check", label = "check")), tabName = "item1"),
                            menuItem("item 2", tabName = "item2", icon = icon("list-alt"))
                          )
                        ),
                        dashboardBody(
                          tabItems(
                            tabItem(tabName = "item1",
                                    tabsetPanel(id = "tabs1",
                                                tabPanel("Tab1", plotOutput("1")),
                                                tabPanel("Tab2", plotOutput("2"))
    
                                    )),
                            tabItem(tabName = "item2",
                                    tabsetPanel(id = "tabs2",
                                                tabPanel("Tab3", plotOutput("3")),
                                                tabPanel("Tab4", plotOutput("4"))
                                    )
                            )
                          )
                        )
    )
    
    server <- function(input, output) {}
    
    shinyApp(ui, server)