Shiny Dashboard：渲染多个菜单项并将动态内容输出到每个菜单项答案

【问题标题】：Shiny Dashboard: Render multiple menu items and output dynamic content to eachShiny Dashboard：渲染多个菜单项并将动态内容输出到每个菜单项
【发布时间】：2017-10-20 17:45:22
【问题描述】：

我需要根据一些反应数据值来渲染各种菜单子项。对于每个子项，我还需要关联链接输出。我尝试与tabName 链接，但不知道出了什么问题。

下面是一个例子。所需的输出将是每个菜单项/子项的一个框。

## This code snippet doesn't do what I need ----
shinyApp(
  ui = dashboardPage(
    dashboardHeader(),
    dashboardSidebar(
      sidebarMenu(
        menuItemOutput("dynamic_menu"),
        menuItem("Menu2", tabName = "menu2")
      )
    ),
    dashboardBody(
      tabItems(
        uiOutput("menu1_content"),
        tabItem(tabName = "menu2", box("I am menu2"))
      )
    ),
    title = "Example"
  ),

  server = function(input, output) {
    output$dynamic_menu <- renderMenu({
      submenu_list <- lapply(letters[1:5], function(x) {
        menuSubItem(x, tabName = paste0("menu1-", x))
      })
      menuItem(
        text = "Menu1",
        startExpanded = TRUE,
        do.call(tagList, submenu_list)
      )
    })

    output$menu1_content <- renderUI({
      content_list <- lapply(letters[1:5], function(x) {
        tabItem(
          tabName = paste0("menu1-", x),
          box(x)
        )
      })
      do.call(tagList, content_list)
    })
  }
)


## This code snippet does what I need ----
shinyApp(
  ui = dashboardPage(
    dashboardHeader(),
    dashboardSidebar(
      sidebarMenu(
        menuItem(
          "Menu1", startExpanded = TRUE,
          menuSubItem("a", tabName = "menu1-a"),
          menuSubItem("b", tabName = "menu1-b"),
          menuSubItem("c", tabName = "menu1-c"),
          menuSubItem("d", tabName = "menu1-d"),
          menuSubItem("e", tabName = "menu1-e")
        ),
        menuItem("Menu2", tabName = "menu2")
      )
    ),
    dashboardBody(
      tabItems(
        tabItem(tabName = "menu1-a", box("a")),
        tabItem(tabName = "menu1-b", box("b")),
        tabItem(tabName = "menu1-c", box("c")),
        tabItem(tabName = "menu1-d", box("d")),
        tabItem(tabName = "menu1-e", box("e")),
        tabItem(tabName = "menu2", box("I am menu2"))
      ),
      title = "Example"
    )
  ),
  server = function(input, output) {}
)

【问题讨论】：

标签： r shiny shinydashboard

【解决方案1】：

回答我自己的问题，但如果你有更优雅的东西，请随时加入。

我觉得我对shinydashboard的初步理解是错误的，导致app结构失效。

这里的技巧是将id 添加到sidebarMenu，以便以后可以跟踪和解析页面焦点。然后每个渲染函数都会监听输入并渲染相关的内容。

shinyApp(
  ui = dashboardPage(
    dashboardHeader(),
    dashboardSidebar(
      sidebarMenu(
        id = "sidebar_menu",
        menuItemOutput("dynamic_menu"),
        menuItem("Menu2", tabName = "menu2")
      )
    ),
    dashboardBody(
      uiOutput("menu1_content"),
      uiOutput("menu2_content")
    ),
    title = "Example"
  ),
  server = function(input, output, session) {
    output$dynamic_menu <- renderMenu({
      menu_list <- lapply(letters[1:5], function(x) {
        menuSubItem(x, tabName = paste0("menu1-", x))
      })
      menuItem(
        text = "Menu1",
        startExpanded = TRUE,
        do.call(tagList, menu_list)
      )
    })

    output$menu1_content <- renderUI({
      sidebar_menu <- tstrsplit(input$sidebar_menu, "-")
      if (sidebar_menu[[1]] == "menu1") box(sidebar_menu[[2]])
    })

    output$menu2_content <- renderUI({
      sidebar_menu <- tstrsplit(input$sidebar_menu, "-")
      if (sidebar_menu[[1]] == "menu2") box("I am menu2")
    })
  }
)

【讨论】：