shinydashboard dynamic menu with submenuitems

Question

I have an Excel sheet with indicator information that can change. I want to use this excel file to create a dynamic menu. In contrast to other posts I found, I want to create a menu with submenuitems.

Here is what the indicator information might look like:

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

Note the IDs within the group level (the groups can change too):

> 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

I built a small example app, that shows what I want to do.

I want to do two things:

Automatically create the menu in a way it includes the submenuitems.

Based on the submenuitem clicked, I want to show a box with information. The title of the box is the fullname of the ID of the indicator clicked (I don't understand why the current example does not work for this part of the functionality).

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


  }
)

A. S. K. A. S. K. · Accepted Answer · 2019-06-28T05:21:34

Here's code to make the dynamic sub-items. The basic idea is to wrap the list of menu items inside sidebarMenu, and to give each menu item a list of its sub-items.

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

The title of the box is easier; it wasn't showing up because the input had ID_ prefixed to the ID, so it didn't match the ID in the dataframe. Once we add ID_, the title shows up as desired.

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 dynamic menu with submenuitems

1 Answers