带子菜单项的shinydashboard动态菜单

带子菜单项的shinydashboard动态菜单,r,menuitem,shinydashboard,R,Menuitem,Shinydashboard,我有一张excel表格,上面有可以更改的指标信息。我想用这个excel文件创建一个动态菜单。与我找到的其他帖子不同,我想创建一个包含子菜单项的菜单 以下是指标信息可能的样子: Dataframe_for_menu <- data.frame(group=rep(c("Numbers", "Letters", "Other"), each=3), ID=c(1,3,5,"A", "C", "O", "test1", "test

我有一张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"))))
我构建了一个小示例应用程序,它显示了我想要做的事情

我想做两件事:

1) 以包含子菜单项的方式自动创建菜单。 2) 根据单击的子菜单项,我想显示一个包含信息的框。框的标题是所单击的指示器ID的全名(我不明白为什么当前示例不适用于这部分功能)

库(闪亮)
图书馆(shinydashboard)
shinyApp(
ui=仪表板页面(
仪表板标题(),
仪表板侧栏(
侧边栏菜单(
id=“侧边栏菜单”,
菜单输出(“动态菜单”)
)
),
仪表板主体(
文本输出(“文本”),
uiOutput(“框1”)
),
title=“示例”
),
服务器=功能(输入、输出、会话){
#菜单(需要更改以反映两个菜单级别:组与ID)

输出$dynamic_menu以下是生成动态子项的代码。基本思想是将菜单项列表包装在
侧边栏菜单中,并为每个菜单项提供其子项的列表

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


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