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

具有子菜单的Shinydashboard动态菜单

1 个答案: