Shiny的dashboardSidebar切换tabItem仅显示B组面板问题求助

问题原因 #

shinydashboard的menuItem存在默认规则：如果menuItem内部嵌套了其他组件（本案例中为Group A下的两个selectInput），该menuItem会被识别为可折叠的父级菜单，点击时仅触发展开/收起操作，不会跳转到绑定的tabName对应面板。Group B的menuItem无嵌套内容，因此点击可正常跳转。

解决方法（完全保留现有侧边栏架构，仅需修改menuItem参数） #

给Group A的menuItem增加两个参数即可：

• href = "#shiny-tab-gpA"：手动绑定点击跳转目标，shiny生成的tabItem默认DOM ID规则为shiny-tab-+你设置的tabName
• newtab = FALSE：禁止跳转时打开新标签页

如果需要页面加载时默认展开Group A下的选择器，可额外添加startExpanded = TRUE参数。

修改后完整可运行代码 #

library(shiny)
library(shinydashboard)
library(leaflet)

ui <- dashboardPage(
  dashboardHeader(title = "DASHBOARD"),
  dashboardSidebar(width = 250,
                   sidebarMenu(
                     # 仅修改Group A的menuItem参数即可
                     menuItem( "Group A",tabName = "gpA",
                               href = "#shiny-tab-gpA",
                               newtab = FALSE,
                               startExpanded = TRUE, # 可选参数，默认展开菜单
                               selectInput(inputId = "Var1",label="variable 1", choices = c("Total","cat1","cat2"),
                                           selected="Total"),
                               selectInput(inputId = "Var2",label="variable 2", choices = c("Total","cat1","cat2"),
                                           selected="Total")),
                     menuItem("Group B",tabName = "gpB")
                   )
  ),
  dashboardBody(
    tabItems(
      tabItem(
        tabName = "gpA",
        fluidRow(box(selectInput(inputId = "Hospital1",choices = c(LETTERS),
                                 label = "Choice hospital 1"),
                     width = 6,height = 70,
                     solidHeader = TRUE),
                 box(selectInput(inputId = "Hospital2",choices = rev(c(LETTERS)), # 原代码此处拼写错误Hopital2已修正
                                 label = "Choice hospital 2"),
                     width = 6,height = 70,
                     solidHeader = TRUE)),
        fluidRow( tabsetPanel(
          tabPanel("Sub group A2", 
                   box(leafletOutput("map1")),box(leafletOutput("map2")) # 原代码输出ID为空已补充，避免报错
          ),
          tabPanel("Sub group A3", box(leafletOutput("map3")),
                   box(leafletOutput("map4"))),
          tabPanel("Concurrence", leafletOutput("map5"))
        ))
      ),
      tabItem(
        tabName = "gpB",
        fluidRow(box(selectInput(inputId = "Commune",choices = c(letters),
                                 label = "choice a Zip code"),
                     width = 6,height = 70,
                     solidHeader = TRUE)),
        fluidRow( tabsetPanel(
          tabPanel("Sub group B1", 
                   leafletOutput("map6")
          ),
          tabPanel("Sub group B2", 
                   leafletOutput("map7"))
        ))
      )
    )
  )
)

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

}

shinyApp(ui, server)

额外说明 #

原代码中存在两个不影响核心功能但会导致运行警告的问题，已在修改后代码中标注修正：

• 第二个医院选择器的ID拼写错误Hopital2修正为Hospital2
• 所有leafletOutput的ID为空，补充了唯一ID避免渲染报错

内容的提问来源于stack exchange，提问作者Seydou GORO