Shinydashboard：在多个 menuSubItems 的情况下，menuSubItem 不会在开始时呈现

Question

我发现在多个（不止一个）tabItems 的情况下，menuSubItem 内容不会呈现。

演示此行为的最小示例如下。

所需的行为是在启动时显示标记为selected = TRUE的 tabItem 的内容。 现在，只有在侧栏中的 menuSubItems 之间切换后才会显示内容。

我怎样才能让它工作？

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(title = "MINIMAL EXAMPLE"),
  dashboardSidebar(
    sidebarMenuOutput("menu")
  ),
  dashboardBody(
    uiOutput("body")
  )
)

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

  output$menu <- renderMenu(
    sidebarMenu(
        menuItem(text = "TABS", tabName = "TABS", startExpanded = T,
                 menuSubItem(text = "tab1", tabName="tab1",
                             icon = icon("cube"), selected = TRUE),
                 menuSubItem(text = "tab2", tabName="tab2",
                             icon = icon("cube"), selected = FALSE)
        )
   )
  )

  output$body <- renderUI({
    tabItems(
      tabItem(tabName = "tab1", 
              h4("MY TEXT 1")
      ),
      tabItem(tabName = "tab2", 
              h4("MY TEXT 2")
      ))
  })
}

shinyApp(ui = ui, server = server)

Answer 1

确实，将 ui 元素直接放在 UI 中可以解决这个问题。 但是将所有内容放入 ui 的方法仅限于不涉及使用反应值的情况。 据我了解，一般不可能将反应值从服务器传递到 ui（或仅限于特殊情况）。 如果我错了请纠正...谢谢

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(title = "MINIMAL EXAMPLE"),
  dashboardSidebar(
    sidebarMenuOutput("menu")
  ),
  dashboardBody(
    tabItems(
      tabItem(tabName = "tab1", 
              h4("MY TEXT 1")
      ),
      tabItem(tabName = "tab2", 
              h4("MY TEXT 2")
      ))
  )
)

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

  output$menu <- renderMenu(
    sidebarMenu(
        menuItem(text = "TABS", tabName = "TABS", startExpanded = T,
                 menuSubItem(text = "tab1", tabName="tab1",
                             icon = icon("cube"), selected = TRUE),
                 menuSubItem(text = "tab2", tabName="tab2",
                             icon = icon("cube"), selected = FALSE)
        )
    )
  )
}

shinyApp(ui = ui, server = server)

Answer 2

将您的输出重命名为“body”以外的其他内容会有所帮助 - 请参阅此。

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(title = "MINIMAL EXAMPLE"),
  dashboardSidebar(
    sidebarMenuOutput("menu")
  ),
  dashboardBody(
    uiOutput("myBodyOutput")
  )
)

server <- function(input, output, session) {
  
  output$myBodyOutput <- renderUI({
    tabItems(
      tabItem(tabName = "tab1", 
              h4("MY TEXT 1")
      ),
      tabItem(tabName = "tab2", 
              h4("MY TEXT 2")
      ))
  })
  
  output$menu <- renderMenu(
    sidebarMenu(id = "sidebarID",
                menuItem(text = "TABS", tabName = "TABS", startExpanded = T,
                         menuSubItem(text = "tab1", tabName="tab1",
                                     icon = icon("cube"), selected = TRUE),
                         menuSubItem(text = "tab2", tabName="tab2",
                                     icon = icon("cube"), selected = FALSE)
                )
    )
  )
  
}

shinyApp(ui = ui, server = server)