具有子菜單的Shinydashboard動態菜單

Question

我有一個Excel工作表，其指標信息可以更改。 我想使用此Excel文件創建一個動態菜單。 與我發現的其他帖子相比，我想創建一個帶有子菜單的菜單。

指標信息可能如下所示：

Dataframe_for_menu <- data.frame(group=rep(c("Numbers", "Letters", "Other"), each=3),
                                 ID=c(1,3,5,"A", "C", "O", "test1", "test2", "test3"),
                                 fullname=c(paste0("This is the full name for item ", c(1,3,5,"A", "C", "O", "test1", "test2", "test3"))))

注意組級別內的ID（組也可以更改）：

> Dataframe_for_menu
    group    ID                             fullname
1 Numbers     1     This is the full name for item 1
2 Numbers     3     This is the full name for item 3
3 Numbers     5     This is the full name for item 5
4 Letters     A     This is the full name for item A
5 Letters     C     This is the full name for item C
6 Letters     O     This is the full name for item O
7   Other test1 This is the full name for item test1
8   Other test2 This is the full name for item test2
9   Other test3 This is the full name for item test3

我構建了一個小示例應用程序，該應用程序顯示了我想要做什么。

我想做兩件事：

1）以包含子菜單的方式自動創建菜單。 2）基於單擊的子菜單，我想顯示一個包含信息的框。 框的標題是單擊的指示器ID的全名（我不明白為什么當前示例不適用於此功能部分）。

library(shiny)
library(shinydashboard)


shinyApp(
  ui = dashboardPage(
    dashboardHeader(),
    dashboardSidebar(
      sidebarMenu(
        id = "sidebar_menu",
        menuItemOutput("dynamic_menu")
      )
    ),
    dashboardBody(

      textOutput("text"),
      uiOutput("box1")

    ),
    title = "Example"
  ),


  server = function(input, output, session) {

    # Menu (THIS WILL NEED TO BE CHANGED TO REFLECT THE TWO MENU LEVELS; GROUP VS. ID)
    output$dynamic_menu <- renderMenu({
      menu_list <- lapply(Dataframe_for_menu$ID, function(x, y) {
        menuSubItem(x, tabName = paste0("ID_", x))
      })
      menuItem(
        text = "Menu1",
        startExpanded = TRUE,
        do.call(tagList, menu_list)
      )
    })


    # Show ID for selected tab
    output$text <- renderText({paste0("The ID of the tab you clicked on is ", input$sidebar_menu)})



    # Box with expanded name
    output$box1 <- renderUI({
      box(title = as.character(Dataframe_for_menu$fullname[as.character(Dataframe_for_menu$ID) == as.character(input$sidebar_menu)]), 
          width = 12,
          collapsible = TRUE, 
          collapsed   = TRUE,
          HTML(
            "<p>Text in a collapsed box</p>"                  
          ))
    })


  }
)

任何幫助，不勝感激！ 干杯，盧克

Answer 1

這是制作動態子項的代碼。 基本思想是將菜單項列表包裝在sidebarMenu ，並為每個菜單項提供其子項的列表。

output$dynamic_menu <- renderMenu({
  menu_list <- lapply(
    unique(Dataframe_for_menu$group),
    function(x) {
      sub_menu_list = lapply(
        Dataframe_for_menu[Dataframe_for_menu$group == x,]$ID,
        function(y) {
          menuSubItem(y, tabName = paste0("ID_", y))
        }
      )
      menuItem(text = x, do.call(tagList, sub_menu_list))
    }
  )
  sidebarMenu(menu_list)
})

框的標題比較容易； 之所以沒有顯示，是因為輸入的ID_前面有ID_ ，所以它與數據框中的ID不匹配。 添加ID_ ，標題將根據需要顯示。

output$box1 <- renderUI({
  box(title = Dataframe_for_menu$fullname[paste0("ID_", Dataframe_for_menu$ID) == input$sidebar_menu],
      width = 12,
      collapsible = TRUE, 
      collapsed   = TRUE,
      HTML(
        "<p>Text in a collapsed box</p>"                  
      ))
})