【问题标题】:Shiny: Output will be shown in every menuItem闪亮:输出将显示在每个菜单项中
【发布时间】:2021-12-28 12:28:18
【问题描述】:

我的 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)```

【问题讨论】:

    标签: r shiny shinydashboard


    【解决方案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,这是一个直到现在我都无法解释的问题。终于可以正常运行了,非常感谢!
    猜你喜欢
    • 2019-08-19
    • 1970-01-01
    • 2017-05-13
    • 1970-01-01
    • 1970-01-01
    • 2016-06-01
    • 2016-08-27
    • 2017-08-06
    • 1970-01-01
    相关资源
    最近更新 更多