Shinydashboard侧边栏菜单无跳转 地图仅指定menuSubItem显示问题求助

• tabName全局重复：shinydashboard要求所有tabName（包括菜单和对应内容块）必须全局唯一，你的代码中不同父菜单下的子菜单重复使用了subitem1~subitem4作为tabName，无法匹配对应内容块，导致侧边栏失去切换功能。
• 内容块定义缺失：dashboardBody的tabItems列表仅定义了Test1（tabName=dashboard）、Test2父菜单（tabName=charts）两个内容块，你需要放置地图的Test3→TTTest1、以及其他所有子菜单都没有对应内容块定义，点击后自然无内容变化。
• 地图挂载位置错误：当前leaflet地图被放在Test1对应的内容块中，不符合你要在Test3→TTTest1下展示的需求。
• 服务端代码语法错误：renderLeaflet中你将地图对象命名为myMap，后续调用多边形添加方法时误用了未定义的变量m，同时代码中使用的completeCPM数据集无加载逻辑，运行时会直接报错。

library(shiny)
library(leaflet)
library(readr)
library(geojsonio)
library(shinydashboard)

sidebar <- dashboardSidebar(
  sidebarMenu(
    id = "sidebar_menu",
    menuItem("Test1", tabName = "dashboard", icon = icon("dashboard")),
    menuItem("Test2",tabName = "charts", icon = icon("bar-chart-o"),
             menuSubItem("TTest1", tabName = "sub2_1"),
             menuSubItem("TTest2", tabName = "sub2_2"),
             menuSubItem("TTest3", tabName = "sub2_3"),
             menuSubItem("TTest4", tabName = "sub2_4")),
    menuItem("Test3", tabName = "choice", icon = icon("dashboard"),
             menuSubItem("TTTest1", tabName = "sub3_1"), # 唯一tabName对应地图内容块
             menuSubItem("TTTest2", tabName = "sub3_2"),
             menuSubItem("TTTest3", tabName = "sub3_3"),
             menuSubItem("TTTest4", tabName = "sub3_4")),
    menuItem("Test4", tabName = "Prod", icon = icon("dashboard"),
             menuSubItem("TTTTest1", tabName = "sub4_1"),
             menuSubItem("TTTTest2", tabName = "sub4_2"),
             menuSubItem("TTTTest3", tabName = "sub4_3"),
             menuSubItem("TTTTest4", tabName = "sub4_4"))
    
  )
)

body <- dashboardBody(
  tabItems(
    # Test1页面内容
    tabItem(tabName = "dashboard",
            fluidRow(
              h2("Test1页面内容")
            )
    ),
    # Test2父菜单内容
    tabItem(tabName = "charts",
            fluidRow(
              tabBox(
                title = "Legend test2",
                id = "tabset2", height = "500px", width = "500px",
                tabPanel("Example", "Hello"),
                tabPanel("Example2", "Hi again")
              ),
            )),
    # Test3下TTTest1内容：放置地图
    tabItem(tabName = "sub3_1",
            fluidRow(
              leafletOutput("myMap"),
              tabBox(
                title = "Legend",
                id = "tabset1", height = "150px", width = "500px",
                tabPanel("Explaining", "If this then that"),
                tabPanel("Source", "Here you can find my data")
              )
            )),
    # 其余子菜单可自行补充对应tabItem内容，示例如下：
    tabItem(tabName = "sub2_1", h2("Test2→TTest1内容")),
    tabItem(tabName = "sub3_2", h2("Test3→TTTest2内容")),
    tabItem(tabName = "sub4_1", h2("Test4→TTTTest1内容"))
  )
)

u <- dashboardPage(
  dashboardHeader(title = "InfoHub"),
  sidebar,
  body
)

s <- function(input,output){
  # 运行前请先自行加载completeCPM数据集，此处为了代码可运行暂时注释相关逻辑
  output$myMap <- renderLeaflet({
    myMap <- leaflet(options = leafletOptions(minZoom = 1)) %>%
      addProviderTiles("OpenStreetMap") %>%
      setView( lng = -87.567215
               , lat = 41.822582
               , zoom = 11 ) %>%
      setMaxBounds( lng1 = -87.94011
                    , lat1 = 41.64454
                    , lng2 = -87.52414
                    , lat2 = 42.02304 )
    
    # 取消注释前请确保completeCPM已加载
    # bins <- c(0, 10, 20, 30, 40, 50, 60, 70, 80, 90)
    # pal <- colorBin("BuGn", domain = completeCPM$OBS_VALUE, bins = bins)
    # 
    # labels <- sprintf(
    #   "<strong>%s</strong><br/>%g Points on a scale",
    #   completeCPM$sovereignt, completeCPM$OBS_VALUE
    # ) %>% lapply(htmltools::HTML)
    # 
    # myMap <- myMap %>% addPolygons(
    #   fillColor = ~pal(OBS_VALUE),
    #   weight = 2,
    #   opacity = 1,
    #   color = "white",
    #   dashArray = "3",
    #   fillOpacity = 0.7,
    #   highlightOptions = highlightOptions(
    #     weight = 5,
    #     color = "#666",
    #     dashArray = "",
    #     fillOpacity = 0.7,
    #     bringToFront = TRUE),
    #   label = labels,
    #   labelOptions = labelOptions(
    #     style = list("font-weight" = "normal", padding = "3px 8px"),
    #     textsize = "15px",
    #     direction = "auto")) %>%
    #   addLegend(pal = pal, values = ~OBS_VALUE,na.label = "Keine Datenquelle vorhanden", opacity = 0.7, title = NULL,
    #             position = "bottomright")
    
    return(myMap)
  })
}
shinyApp(u,s)

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