r-shnydashboard:在"menuItem"中包含输入时，失去了"tabItem

Question

我得到了一个面板，其中显示在dashboardBody中的tabItem取决于在dashboardMenu上选择的menuItem，如下所示：

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)