Shiny Dashboard: Render multiple menu items and output dynamic content to each

为君一笑 提交于 2019-12-12 05:57:17

问题


I need to render various menu sub-items based on some reactive data values. For each sub-item, I also need to associate linked output. I tried to link with tabName, but not sure what went wrong.

Below is an example. The desired output will be one box for each menu item/sub-item.

## 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) {}
)

回答1:


Answering my own question, but feel free to jump in if you have something more elegant.

I think my initial understanding of shiny dashboard is wrong, causing the app structure to be invalid.

The trick here is to add id to the sidebarMenu, so that page focus could be tracked and parsed later. Then each of the render function will listen on the input and render associated content.

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")
    })
  }
)


来源:https://stackoverflow.com/questions/46854589/shiny-dashboard-render-multiple-menu-items-and-output-dynamic-content-to-each

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!