динамическое меню shinydashboard с подменю - PullRequest
Новая
       32

динамическое меню shinydashboard с подменю

1 голос
/ 08 апреля 2019

У меня есть лист 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"))))

Обратите внимание на идентификаторы на уровне группы (группы также могут меняться): 

> 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) На основании нажатого подменю, я хочу показать окно с информацией. Заголовок поля - это полное имя идентификатора нажатого индикатора (я не понимаю, почему текущий пример не работает для этой части функциональности). 

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


  }
)

Любая помощь с благодарностью! Ура, Люк

1 Ответ

0 голосов
/ 28 июня 2019

Вот код для создания динамических подпунктов.Основная идея заключается в том, чтобы обернуть список пунктов меню внутри 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_, заголовок отобразится по желанию. 

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