R shinydashboard: Mix of dynamic and static tabItems for various menusubitems

Question

I am building an app with three segments:

1. Overview
2. Detailed results
3. Help

The detailed result section should show results of many sub-items, one at the time.

I am interested to the Result section to be a single tab, because I don't want to write code each tab for each sub-item. Each sub-item has identical, in the example a histogram.

When I run the example though, I loose the ID of the subitems. Is it possible to have a layout like this but to keep the ID's of all menuitems and menusubitems?

Happy to look at alternative approaches.

An example to illustrate the issue is below. The solution will show the table in overview, a histogram in results for any of the sub-items and the HTML output in the help section.

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(), 
  dashboardSidebar(
    sidebarMenu(id = "SideBarMENU", 

                menuItem("Overview", tabName = "OVERVIEW", selected = TRUE),
                menuItem("Results",  startExpanded = TRUE,
                         menuSubItem("Sepal.Length", tabName = "RESULTS"),
                         menuSubItem("Sepal.Width" , tabName = "RESULTS"),
                         menuSubItem("Petal.Length", tabName = "RESULTS"),
                         menuSubItem("Petal.Width" , tabName = "RESULTS")
                ), 
                menuItem("Help", tabName = "HELP")
    )

  ),
  dashboardBody(
    tabItems(
      tabItem("OVERVIEW", 
              box("Overview box", 
                  tableOutput("overview"))
      ),
      tabItem("RESULTS", 
              box("Results box", 
                  plotOutput("results")
              )
      ),
      tabItem("HELP", 
              box("HELP box", 
                  textOutput("help"))
      ) 
    )
  )
)

server <- function(input, output, session) {


  data <- reactive({

    print(input$SideBarMENU)

    if(input$SideBarMENU %in% names(iris)){
      iris[[input$SideBarMENU]]
    } else {
      rnorm(100, 1000, 10)
    }
  })


  output$results <- renderPlot({
    hist(data())
  })


  output$overview <- renderTable({
    head(iris)
  })



  output$help <- renderText({
    HTML("A wiki is a website on which users collaboratively.....")
  })



}

shinyApp(ui, server)

Answer 1

Basically, you need two components:

1. Dynamic content / plots

2. Dynamic dashboard body

The first part is more easy:

1. Dynamic content / plots

You can create the outputs in a loop as explained in a few other SO posts:

  lapply(nms, function(name){
    output[[name]] <- renderUI ({
      box("Results Box", plotOutput(paste0("plot_", name)))
    })

    output[[paste0("plot_", name)]] <- renderPlot({
      hist(iris[[input$SideBarMENU]], main = "")
    })
  })

2. Dynamic dashboard body

This part is more complicated. You need dynamic tabitems() and they have to be mixed with static parts. In order to hand over a list of tabitem() to tabitems() you can use do.call(tabItems, ..) for converting it, see the link below. To combine them with the static elements, convert the static ones as list() elements and combine them all in a list() before calling do.call(tabItems, ..) .

  output$tabItms <- renderUI ({
    itemsDyn <- lapply(nms, function(name){
      tabItem(tabName = name, uiOutput(name))
    })

    items <- c(
      list(
        tabItem("OVERVIEW", 
              box("Overview box", 
                  tableOutput("overview"))
        )
      ),  
      itemsDyn,
      list(
        tabItem("HELP", 
                box("HELP box", 
                    textOutput("help"))
        )
      )
    )
    do.call(tabItems, items)
  })

Similar components can be found here: shinydashboard does not work with uiOutput and for looping tabItems() here: How to make a function in a for loop or lapply loop in a tabItem dashboard shiny .

Note:

I modify names(iris) :

nms <- gsub("[.]", "", names(iris))
names(iris) <- nms

because no dots are allowed for the tabItem names.

Reproducible example:

library(shiny)
library(shinydashboard)

nms <- gsub("[.]", "", names(iris))
names(iris) <- nms


ui <- dashboardPage(
  dashboardHeader(), 
  dashboardSidebar(
    uiOutput("menu")
  ),
  dashboardBody(
    uiOutput("tabItms")
  )
)

server <- function(input, output, session) {

  output$tabItms <- renderUI ({
    itemsDyn <- lapply(nms, function(name){
      tabItem(tabName = name, uiOutput(name))
    })

    items <- c(
      list(
        tabItem("OVERVIEW", 
              box("Overview box", 
                  tableOutput("overview"))
        )
      ),  
      itemsDyn,
      list(
        tabItem("HELP", 
                box("HELP box", 
                    textOutput("help"))
        )
      )
    )
    do.call(tabItems, items)
  })

  lapply(nms, function(name){
    output[[name]] <- renderUI ({
      box("Results Box", plotOutput(paste0("plot_", name)))
    })

    output[[paste0("plot_", name)]] <- renderPlot({
      hist(iris[[input$SideBarMENU]], main = "")
    })
  })



  output$menu <- renderUI({
    sidebarMenu(id = "SideBarMENU", 
                menuItem("Overview", tabName = "OVERVIEW", selected = TRUE),
                menuItem("Results", id = "resultChoice",  startExpanded = TRUE,
                         lapply(nms, function(name) {
                           menuSubItem(name, tabName = name)
                         })
                ), 
                menuItem("Help", tabName = "HELP")
    )
  })

  output$overview <- renderTable({
    head(iris)
  })

  output$help <- renderText({
    HTML("A wiki is a website on which users collaboratively.....")
  })

}

shinyApp(ui, server)