rshinyshinydashboardmenuitemsidebar

Direct input elements in shinydashboard sidebar


I was wondering if I could modify the following shiny app and put the sliderInput into the sidebar section :

 library(shinydashboard)
    
    ui <- dashboardPage(
      dashboardHeader(title = "DB manager"),
      dashboardSidebar(
        sidebarMenu(
          menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
          menuItem("Widgets", tabName = "widgets", icon = icon("th"))
        )
      ),
      dashboardBody(
        tabItems(
          # First tab content
          tabItem(tabName = "dashboard",
                  fluidRow(
                    box(plotOutput("plot1", height = 250)),
                    
                    box(
                      title = "Controls",
                      sliderInput("slider", "Number of observations:", 1, 100, 50)
                    )
                  )
          ),
          
          # Second tab content
          tabItem(tabName = "widgets",
                  h2("Widgets tab content")
          )
        )
      )
    )
    
    server <- function(input, output) {
      set.seed(122)
      histdata <- rnorm(500)
      
      output$plot1 <- renderPlot({
        data <- histdata[seq_len(input$slider)]
        hist(data)
      })
    }
    
    shinyApp(ui, server)

Something like : Below I have used the menuItem inside menuItem. for the first sleider, I can see the plot but for the second I can not !

library(shinydashboard)

    ui <- dashboardPage(
      dashboardHeader(title = "DB manager"),
      dashboardSidebar(
        # sidebarMenu(
        #   menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard"),
        #            sliderInput("slider", "Number of observations:", 1, 100, 50)),
        #   menuItem("Widgets", tabName = "widgets", icon = icon("th"))
        # )
        
        sidebarMenu(
          menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard"),
                   sliderInput("slider", "Number of observations:", 1, 100, 50),
                   menuItem("", tabName = "dashboard2")
          ),
          menuItem("Widgets", tabName = "widgets", icon = icon("th"),
                   sliderInput("slider1", "Number of observations:", 1, 100, 50),
                   menuItem("", tabName = "dashboard3"))
        )
      ),
      dashboardBody(
        tabItems(
          # First tab content
          tabItem(tabName = "dashboard2",
                  fluidRow(
                    box(plotOutput("plot1", height = 250))
                    
                  )
          ),
          
          # Second tab content
          tabItem(tabName = "dashboard3",
                  fluidRow(
                    box(plotOutput("plot2", height = 250))
                    
                  )
          )
        )
      )
    )
    
    server <- function(input, output) {
      set.seed(122)
      histdata <- rnorm(500)
      
      output$plot1 <- renderPlot({
        data <- histdata[seq_len(input$slider)]
        hist(data)
      })
      
      output$plot2 <- renderPlot({
        data <- histdata[seq_len(input$slider1)]
        hist(data)
      })
    }
    
    shinyApp(ui, server)

Any Idea how I could achieve that ?


Solution

  • When you have a child item, you need to define another menuItem or menuSubItem. Try the code below. Please note that (in the code below) you cannot access tabName dashboard, but only dashboard2.

    sidebarMenu(
          menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard"),
                   sliderInput("slider", "Number of observations:", 1, 100, 50),
                   menuItem("Dashboard2", tabName = "dashboard2", icon = icon("dashboard"))
                   ),
          menuItem("Widgets", tabName = "widgets", icon = icon("th"))
        )
    

    Update: Try this it works fine for me. Please note that you have to select the tab "A" or "B" to view the plot. The main menuItem only lets you see the selections possible in the sidebar - like slider or other items. You can also define ID for the sidebarmenu, and then update the tabs automatically, whenever there is a change in input via slider by using observers. Define expandedName, and access it via input$sidebarItemExpanded to update the tabs automatically via observer.

    library(shinydashboard)
    
    ui <- dashboardPage(
      dashboardHeader(title = "DB manager"),
      dashboardSidebar(
        sidebarMenu(id="tabs",
          menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard"), expandedName = "tab1",
                   sliderInput("slider", "Number of observations:", 1, 100, 50),
                   menuItem("A", tabName = "dashboard2")
          ),
          menuItem("Widgets", tabName = "widgets", icon = icon("th"), expandedName = "tab2",
                   sliderInput("slider1", "Number of observations:", 1, 100, 50),
                   menuItem("B", tabName = "dashboard3"))
        )
      ),
      dashboardBody(
        tabItems(
          # First tab content
          tabItem(tabName = "dashboard2",
                  fluidRow(
                    box(plotOutput("plot1", height = 250))
                  )
          ),
          
          # Second tab content
          tabItem(tabName = "dashboard3",
                  fluidRow(
                    box(plotOutput("plot2", height = 250))
                  )
          )
        )
      )
    )
    
    server <- function(input, output, session) {
      set.seed(122)
      histdata <- rnorm(500)
      
      output$plot1 <- renderPlot({
        data <- histdata[seq_len(input$slider)]
        hist(data)
      })
     
      observeEvent(input$sidebarItemExpanded, { 
        print(input$sidebarItemExpanded)
        if ( input$sidebarItemExpanded == "tab1") updateTabItems(session,"tabs","dashboard2")
        
        if (input$sidebarItemExpanded=="tab2")   updateTabItems(session,"tabs","dashboard3") 
        
      }, ignoreNULL = TRUE)
      
      output$plot2 <- renderPlot({
        # data <- histdata[seq_len(input$slider1)]
        # hist(data)
        plot(cars)
      })
    }
    
    shinyApp(ui, server)