shinydashboard: потеря реакции `tabItem` при включении входных данных в` menuItem`

Question

У меня есть панель управления, где tabItem, который отображается в dashboardBody, зависит от menuItem, выбранного в dashboardMenu, например:

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)

Однако, как только Я включаю вход в menuItem, этот ответ потерян:

 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)

Answer 1

Применение этого ответа к вашему примеру работает. Вот решение:

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)