闪亮：输出将显示在每个菜单项中

Question

我的 Shinydashboard 有问题：我创建了一个地图，我只想在 MenuItem“Test3”的 menuSubItem (TTTest1) 中显示它。截至目前，将显示的唯一内容是我的地图和 tabBox“Legend”。我假设我拥有的侧边栏没有真正的功能，因为即使我点击侧边栏的任何项目，也没有空白页 - 只有我的地图和一个 tabBox 并没有真正改变，就好像它是“静态的” .

谁能告诉我哪里出了问题以及我在哪里犯了这个（大）错误？

library(shiny)    # for shiny apps
library(leaflet)  # renderLeaflet function
library(readr)
library(geojsonio)
library(shinydashboard)


sidebar <- dashboardSidebar(
  sidebarMenu(
    menuItem("Test1", tabName = "dashboard", icon = icon("dashboard")),
    menuItem("Test2",tabName = "charts", icon = icon("bar-chart-o"),
          menuSubItem("TTest1", tabName = "subitem1"),
          menuSubItem("TTest2", tabName = "subitem2"),
          menuSubItem("TTest3", tabName = "subitem3"),
          menuSubItem("TTest4", tabName = "subitem4")),
    menuItem("Test3", tabName = "choice", icon = icon("dashboard"),
             menuSubItem("TTTest1", tabName = "subitem1"),
             menuSubItem("TTTest2", tabName = "subitem2"),
             menuSubItem("TTTest3", tabName = "subitem3"),
             menuSubItem("TTTest4", tabName = "subitem4")),
    menuItem("Test4", tabName = "Prod", icon = icon("dashboard"),
           menuSubItem("TTTTest1", tabName = "subitem1"),
           menuSubItem("TTTTest2", tabName = "subitem2"),
           menuSubItem("TTTTest3", tabName = "subitem3"),
           menuSubItem("TTTTest4", tabName = "subitem4"))
             
    )
  )

  
  body <- dashboardBody(
    
    tabItems(
      # Map Output
      tabItem(tabName = "dashboard",
              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(tabName = "charts",
            fluidRow(
              tabBox(
                title = "Legend test2",
                # The id lets us use input$tabset1 on the server to find the current tab
                id = "tabset2", height = "500px", width = "500px",
                tabPanel("Example", "Hello"),
                tabPanel("Example2", "Hi again")
              ),
            ))
      
    )
  )

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

s <- function(input,output){
    
    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 )
      
      
      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**strong text**",
        completeCPM$sovereignt, completeCPM$OBS_VALUE
      ) %>% lapply(htmltools::HTML)
      
      m %>% 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")
    })
    
    
}
shinyApp(u,s)```

Answer 1

您没有正确使用 tabName。首先，您不应该在 sidebar 中重复使用选项卡名称。那些将发生冲突。您的很多 menuSubItem 选项卡都有重复的值。应该固定为类似...

sidebar <- dashboardSidebar(
  sidebarMenu(
    menuItem("Test1", tabName = "dashboard", icon = icon("dashboard")),
    menuItem("Test2",tabName = "charts", icon = icon("bar-chart-o"),
          menuSubItem("TTest1", tabName = "subitem1"),
          menuSubItem("TTest2", tabName = "subitem2"),
          menuSubItem("TTest3", tabName = "subitem3"),
          menuSubItem("TTest4", tabName = "subitem4")),
    menuItem("Test3", tabName = "choice", icon = icon("dashboard"),
             menuSubItem("TTTest1", tabName = "subitem4"),
             menuSubItem("TTTest2", tabName = "subitem5"),
             menuSubItem("TTTest3", tabName = "subitem6"),
             menuSubItem("TTTest4", tabName = "subitem7")),
    menuItem("Test4", tabName = "Prod", icon = icon("dashboard"),
           menuSubItem("TTTTest1", tabName = "subitem8"),
           menuSubItem("TTTTest2", tabName = "subitem9"),
           menuSubItem("TTTTest3", tabName = "subitem10"),
           menuSubItem("TTTTest4", tabName = "subitem11"))
             
    )
  )

注意现在没有重复的 tabNames。这些是您要在 dashBoardBody 中使用的内容，用于将侧边栏与应用程序的 body 相关联。

如果您希望 leaflet 地图出现在 Test3/TTTest1 中，您需要专门使用 tabName。在上面的代码块中，tabName = "subitem4".

 body <- dashboardBody(
   
   tabItems(
     # Map Output
     tabItem(tabName = "subitem4",
             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")
               ),
               
        )
     ),

您的 sidebar 菜单与这些页面 body 上显示的内容之间的联系是 tabName。

闪亮：输出将显示在每个菜单项中

Shiny: Output will be shown in every menuItem

r

shiny

shinydashboard