rshinyshinydashboard

Usage of UIOutput in multiple menuItems


The R shiny script below displays "output$brand_selector" output in subItem1. I wish to display the same output in subItem2 and subItem3. Also when I open the dashboard, the output is present by default, I wish to make it appear only when I click on a subItem.

candyData <- read.table(
text = "
Brand       Candy           value
Nestle      100Grand        Choc1
Netle       Butterfinger    Choc2
Nestle      Crunch          Choc2
Hershey's   KitKat          Choc4
Hershey's   Reeses          Choc3
Hershey's   Mounds          Choc2
Mars        Snickers        Choc5
Nestle      100Grand        Choc3
Nestle      Crunch          Choc4
Hershey's   KitKat          Choc5
Hershey's   Reeses          Choc2
Hershey's   Mounds          Choc1
Mars        Twix            Choc3
Mars        Vaid            Choc2",
header = TRUE,
stringsAsFactors = FALSE)
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
  
  id = "tabs",
  menuItem("Charts", icon = icon("bar-chart-o"),
           menuSubItem("Sub-item 1", tabName = "subitem1"),
           menuSubItem("Sub-item 2", tabName = "subitem2"),
           menuSubItem("Sub-item 3", tabName = "subitem3")
  ))),
dashboardBody(
tabItems(tabItem("subitem1", uiOutput("brand_selector")),
         tabItem("subitem2", 4),
         tabItem("subitem3", 7))
))
server <- function(input, output,session) {
observeEvent(input$Select1,{
updateSelectInput(session,'Select2',
               
choices=unique(candyData$Candy[candyData$Brand==input$Select1]))
}) 
observeEvent(input$Select2,{
updateSelectInput(session,'Select3',
                
choices=unique(candyData$value[candyData$Brand==input$Select1 & 
candyData$Candy==input$Select2]))
})
output$brand_selector <- renderUI({
box(title = "Data", status = "primary", solidHeader = T, width = 12,
    fluidPage(
      fluidRow(
        
        column(2,offset = 0, style='padding:1px;',  
 selectInput("Select1","select1",unique(candyData$Brand))),
        column(2,offset = 0, 
  style='padding:1px;',selectInput("Select2","select2",choices = NULL)),
        column(2, offset = 0, 
  style='padding:1px;',selectInput("Select3","select3",choices=NULL ))
      )))
  })}
  shinyApp(ui = ui, server = server)

Subitem capture


Solution

  • You could create a dummy tabItem which is hidden and select that bu default. This will give the illusion that no tabItem is selected. To hide the tabItem option you could use hidden function from shinyjs package.

    Following is the modified ui code:

    ui <- dashboardPage(
        dashboardHeader(),
        dashboardSidebar(
          sidebarMenu(
           shinyjs::useShinyjs(),
            id = "tabs",
            menuItem("Charts", icon = icon("bar-chart-o"),
                     shinyjs::hidden(menuSubItem("dummy", tabName = "dummy")),
                     menuSubItem("Sub-item 1", tabName = "subitem1"),
                     menuSubItem("Sub-item 2", tabName = "subitem2"),
                     menuSubItem("Sub-item 3", tabName = "subitem3")
            ))),
        dashboardBody(
          tabItems(tabItem("dummy"),
                  tabItem("subitem1", uiOutput("brand_selector")),
                   tabItem("subitem2", 4),
                   tabItem("subitem3", 7))
        ))
    

    EDIT1: As per the comments and reference from the answers given bu Joe here you can do that as follows:

    candyData <- read.table(
        text = "
        Brand       Candy           value
        Nestle      100Grand        Choc1
        Netle       Butterfinger    Choc2
        Nestle      Crunch          Choc2
        Hershey's   KitKat          Choc4
        Hershey's   Reeses          Choc3
        Hershey's   Mounds          Choc2
        Mars        Snickers        Choc5
        Nestle      100Grand        Choc3
        Nestle      Crunch          Choc4
        Hershey's   KitKat          Choc5
        Hershey's   Reeses          Choc2
        Hershey's   Mounds          Choc1
        Mars        Twix            Choc3
        Mars        Vaid            Choc2",
        header = TRUE,
        stringsAsFactors = FALSE)
      library(shiny)
      library(shinydashboard)
      ui <- dashboardPage(
        dashboardHeader(),
        dashboardSidebar(
          sidebarMenu(
           shinyjs::useShinyjs(),
            id = "tabs",
            menuItem("Charts", icon = icon("bar-chart-o"),
                     shinyjs::hidden(menuSubItem("dummy", tabName = "dummy")),
                     menuSubItem("Sub-item 1", tabName = "subitem1"),
                     menuSubItem("Sub-item 2", tabName = "subitem2"),
                     menuSubItem("Sub-item 3", tabName = "subitem3")
            ))),
        dashboardBody(
          tabItems(tabItem("dummy"),
                  tabItem("subitem1", uiOutput("brand_selector")),
                   tabItem("subitem2", uiOutput("brand_selector1")),
                   tabItem("subitem3", uiOutput("brand_selector2")))
        ))
      server <- function(input, output,session) {
        
        
        observeEvent(input$Select1,{
          updateSelectInput(session,'Select2',
                            
                            choices=unique(candyData$Candy[candyData$Brand==input$Select1]))
        }) 
        observeEvent(input$Select2,{
          updateSelectInput(session,'Select3',
                            
                            choices=unique(candyData$value[candyData$Brand==input$Select1 & 
                                                             candyData$Candy==input$Select2]))
        })
        output$brand_selector1 <-  output$brand_selector2 <-  output$brand_selector <- renderUI({
          box(title = "Data", status = "primary", solidHeader = T, width = 12,
              fluidPage(
                fluidRow(
                  
                  column(2,offset = 0, style='padding:1px;',  
                         selectInput("Select1","select1",unique(candyData$Brand))),
                  column(2,offset = 0, 
                         style='padding:1px;',selectInput("Select2","select2",choices = NULL)),
                  column(2, offset = 0, 
                         style='padding:1px;',selectInput("Select3","select3",choices=NULL ))
                )))
        })}
      shinyApp(ui = ui, server = server)
    

    EDIT2:

    Here is a slightly different approach without using renderUI and using shinyModule:

    candyData <- read.table(
      text = "
      Brand       Candy           value
      Nestle      100Grand        Choc1
      Netle       Butterfinger    Choc2
      Nestle      Crunch          Choc2
      Hershey's   KitKat          Choc4
      Hershey's   Reeses          Choc3
      Hershey's   Mounds          Choc2
      Mars        Snickers        Choc5
      Nestle      100Grand        Choc3
      Nestle      Crunch          Choc4
      Hershey's   KitKat          Choc5
      Hershey's   Reeses          Choc2
      Hershey's   Mounds          Choc1
      Mars        Twix            Choc3
      Mars        Vaid            Choc2",
      header = TRUE,
      stringsAsFactors = FALSE)
    library(shiny)
    library(shinydashboard)
    
    submenuUI <- function(id) {
      ns <- NS(id)
      tagList(
        box(title = "Data", status = "primary", solidHeader = T, width = 12,
                  fluidPage(
                    fluidRow(
    
                      column(2,offset = 0, style='padding:1px;',
                             selectInput(ns("Select1"),"select1",unique(candyData$Brand))),
                      column(2,offset = 0,
                             style='padding:1px;',selectInput(ns("Select2"),"select2",choices = NULL)),
                      column(2, offset = 0,
                             style='padding:1px;',selectInput(ns("Select3"),"select3",choices=NULL ))
                    )))
            )
      
    }
    
    # submenu <- function(input,output,session){}
    submenuServ <- function(input, output, session){
    
      observeEvent(input$Select1,{
        updateSelectInput(session,'Select2',
    
                          choices=unique(candyData$Candy[candyData$Brand==input$Select1]))
      })
      observeEvent(input$Select2,{
        updateSelectInput(session,'Select3',
    
                          choices=unique(candyData$value[candyData$Brand==input$Select1 &
                                                           candyData$Candy==input$Select2]))
      })
      
    }
    
    
    
    
    ui <- dashboardPage(
      dashboardHeader(),
      dashboardSidebar(
        sidebarMenu(
          shinyjs::useShinyjs(),
          id = "tabs",
          menuItem("Charts", icon = icon("bar-chart-o"),
                   shinyjs::hidden(menuSubItem("dummy", tabName = "dummy")),
                   menuSubItem("Sub-item 1", tabName = "subitem1"),
                   menuSubItem("Sub-item 2", tabName = "subitem2"),
                   menuSubItem("Sub-item 3", tabName = "subitem3")
          ))),
      dashboardBody(
        tabItems(tabItem("dummy"),
                 tabItem("subitem1", submenuUI('submenu1')),
                 tabItem("subitem2", submenuUI('submenu2')),
                 tabItem("subitem3", submenuUI('submenu3'))
                 )
      ))
    server <- function(input, output,session) {
      
      callModule(submenuServ,"submenu1")
      callModule(submenuServ,"submenu2")
      callModule(submenuServ,"submenu3")
      
    }
    shinyApp(ui = ui, server = server)