Shinydasboard with dynamic menuItem from nestedList

Question

I have this first version (MWE) of my app that works well. The menuItems and TabItems are hard-coded. As you can see there are some menus that are inside others. :

library(shiny)
library(shinydashboard)

ui<-dashboardPage(header=dashboardHeader( title = "MyApp")
                  ,sidebar=dashboardSidebar(uiOutput("sidebarpanel"))
                  ,body=dashboardBody(uiOutput("body"))
                  ,skin = "green",title = "Simple Dashboard")

server <- function(input, output) {

  output$sidebarpanel <- renderMenu({

    sidebarMenu(id="tabs",menuItem(text='Grandfather01',tabName = 'tabnameGrandfather01')
                         ,menuItem(text='Grandfather02'
                                     ,menuItem(text='Father02_01'
                                               ,menuItem(text='Child02_01_01',tabName = 'tabNameChild02_01_01')
                                               ,menuItem(text='Child02_01_02',tabName = 'tabNameChild02_01_02')
                                     )
                          )
                         ,menuItem(text='Grandfather03'
                                   ,menuItem(text='Father03_01',tabName = 'tabNameFather03_01')
                         )
                )

  })

  output$body <- renderUI({

      tabItems(
        tabItem(tabName="tabnameGrandfather01",actionButton("buttonGrandfather01","buttonGrandfather01"))
        ,tabItem(tabName="tabNameChild02_01_01",actionButton("buttontabNameChild02_01_01","buttontabNameChild02_01_01"))
        ,tabItem(tabName="tabNameChild02_01_02",actionButton("buttonChild02_01_02","buttonChild02_01_02"))
        ,tabItem(tabName="tabNameChild02_01_02",actionButton("buttonChild02_01_02","buttonChild02_01_02"))
        ,tabItem(tabName="tabnameFather02_02",actionButton("buttonFather02_02","buttonFather02_02"))
        ,tabItem(tabName="tabNameFather03_01",actionButton("buttonFather03_01","buttonFather03_01"))
      )

  })

}

# Run the application
shinyApp(ui = ui, server = server)

It makes the menus to appear in this way that is OK:

Now, my new requirement is to easily include/exclude some menus. So, I thought to use a list to comment/uncomment some elements of that list. Since there are some menus that are inside others, I have to use a nested list and recursive functions.

I tried to do it in this way but I couldn't figure out:

library(shiny)
library(shinydashboard)


myList<-list()
myList[[length(myList)+1]]<-list(text="Grandfather01",tabName='tabnameGrandfather01',button="buttonGrandfather01")
myList[[length(myList)+1]]<-list(text="Grandfather02",
                                 list(text="Father02_01"
                                      ,list(text='Child02_01_01',tabName='tabNameChild02_01_01',button="buttonChild02_01_01")
                                      ,list(text='Child02_01_01',tabName='tabNameChild02_01_01',button="buttonChild02_01_02")
                                 )
                            )
myList[[length(myList)+1]]<-list(text="Grandfather03",
                                 list(text='Father03_01',tabName='tabNameFather03_01',button="buttonFather03_01")
                            )
# Excluded:No need for now.
#myList[[length(myList)+1]]<-list(text="Grandfather04",tabName='tabnameGrandfather04',button="buttonGrandfather04")
#myList[[length(myList)+1]]<-list(text="Grandfather05",
#                                 list(text='Father05_01',tabName='tabNameFather05_01',button="buttonFather05_01")
#                             )


funGetTabItem<-function(lst){
        mylst<-list()
        if(!is.null(lst$tabName)){
          return(tabItem(tabName=lst$text,actionButton(lst$button,lst$button)))
        }
        else {
          for ( i in seq_len(length(lst))){
            if (is.list(lst[[i]])) mylst[[length(mylst)+1]]<-funGetTabItem(lst[[i]])
          }
          return(mylst)
        }
}

funGetMenuItem<-function(lst){
  mylst<-list()
  if(!is.null(lst$tabName)){
    return(menuItem(lst$text,tabName=lst$tabName))
  }
  else {
    for ( i in seq_len(length(lst))){
      if (is.list(lst[[i]])) mylst[[length(mylst)+1]]<-menuItem(lst$text,funGetMenuItem(lst[[i]]))
    }
    return(mylst)
  }
}


ui<-dashboardPage(header=dashboardHeader( title = "MyApp")
                  ,sidebar=dashboardSidebar(uiOutput("sidebarpanel"))
                  ,body=dashboardBody(uiOutput("body"))
                  ,skin = "green",title = "Simple Dashboard")

server <- function(input, output) {

  output$sidebarpanel <- renderMenu({
    lstMenuItem<-funGetMenuItem(myList)
    sidebarMenu(id="tabs",lstMenuItem)

  })

  output$body <- renderUI({
    lstTabItem<-funGetTabItem(myList)
    do.call(tabItems, lstTabItem)
  })

}

# Run the application
shinyApp(ui = ui, server = server)

This error appears, but I think it is not going to be the only one:

Warning: Error in FUN: Expected an object with class 'shiny.tag'.
  102: stop
  101: FUN
  100: lapply
   99: <Anonymous>
   97: renderUI [D:\Proyectos\scibtracker\appxx/app.R#65]
   96: func
   83: renderFunc
   82: output$body
    1: runApp

I'm not sure whether I chose the worst approach for that requirement or if my attempt is OK, can you give some suggestions or help me to fix it?

Answer 1

There are probably more elegant ways to achieve that and perhaps better data structures to store your nested list but at least the approach below works.

library(shiny)
library(shinydashboard)

funGetTabItem <- function(x) {
  if (is.null(names(x))) {
    items <- lapply(x, funGetTabItem)
    do.call("c", items)
  } else if ("tabName" %in% names(x)) {
    list(x[c("button", "tabName")])  
  } else {
    items <- lapply(x[!names(x) %in% "text"], funGetTabItem)
    do.call("c", items)
  }
}

funGetMenuItem <- function(x) {
  if (is.null(names(x))) {
    lapply(x, funGetMenuItem)
  } else if ("tabName" %in% names(x)) {
    menuItem(text = x[["text"]], tabName = x[["tabName"]])  
  } else {
    items <- lapply(x[!names(x) %in% "text"], funGetMenuItem)
    do.call(menuItem, c(list(text = x[["text"]]), items))
  }
}

ui <- dashboardPage(
  header = dashboardHeader(title = "MyApp"),
  sidebar = dashboardSidebar(uiOutput("sidebarpanel")),
  body = dashboardBody(uiOutput("body")),
  skin = "green", title = "Simple Dashboard"
)

server <- function(input, output) {
  output$sidebarpanel <- renderMenu({
    lstMenuItem <- funGetMenuItem(myList)
    do.call(sidebarMenu, c(list(id = "tabs"), lstMenuItem))
  })

  output$body <- renderUI({
    lstTabItem <- funGetTabItem(myList)
    lstTabItem <- lapply(lstTabItem, function(x) {
      tabItem(tabName = x[["tabName"]], actionButton(x[["button"]], x[["button"]]))  
    })
    do.call(tabItems, lstTabItem)
  })
}

shinyApp(ui = ui, server = server)