CODEWITHSUNDEEP
rshiny
user10256905
user10256905

Reputation: 185

closing sidebar in shiny dashboard

I am trying to make a multipage shiny dashboard. I would like the sidebar to collapse when you pick a page, with the ability to reopen it to pick a new page. For example, when you pick page 2 the sidebar collapses and you can reopen it later if you want to go back to page 1. Right now it is stuck open, i.e. when you click page 2 the sidebar does not collapse. I used useShinyjs(), which is what I thought makes it collapsible with no luck. Any help is much appreciated :)

library(shiny)
library(dplyr)
library(shiny)
library(shinydashboard)
library(shinyjs)
library(shinyWidgets)
library(shinyBS)
library(plotly)

Stores <- data.frame(Store = c("Store 1", "Store 2", "Store 3", "Store 4", "Store 5"),
                     Sales = c(8247930, 423094, 204829, 903982, 7489472, 429085, 208955, 7492852, 5285034, 2958275,1598753, 28487593, 4892049, 583042, 509275, 5904728, 5098325, 5920947, 4920946, 2049583),
                     Avg_cust = c(325,542,582,482,904, 594, 304, 493, 690, 403, 694, 104, 493, 596, 403, 506, 304, 305, 632, 478),
                     Year = c(rep(2012,5), rep(2013,5), rep(2014,5), rep(2015,5)))

ui <- dashboardPage(
  header = dashboardHeader(
    title = "Store Performance",
    titleWidth = "100%"),
  sidebar = dashboardSidebar(
    useShinyjs(),
    width = 200,
    collapsed = FALSE,
    sidebarMenu(id = "tabs",
                menuItem("Page 1", tabName = "pg1"),
                menuItem("Page 2", tabName = "pg2"))),
  skin = "black",
  body = dashboardBody(
    useShinyjs(),
    tabItems(
      tabItem("pg1",
              fluidRow(
                column(width = 3,
                       box(
                         title = "Options",
                         status = 'warning',
                         solidHeader = TRUE,
                         width = 12,
                         collapsible = FALSE,
                         collapsed = FALSE,
                         pickerInput(
                           inputId = "YR",
                           label = "Year:",
                           choices = c(2012,2013,2014,2015),
                           selected = 2015,
                           multiple = FALSE))),
                column(width = 9,
                       boxPlus(plotlyOutput("All"),
                               status = 'warning',
                               width = 12,
                               solidHeader = TRUE,
                               collapsible = FALSE,
                               closable = FALSE,
                               collapsed = FALSE)))),
      tabItem("pg2",
              fluidRow(
                column(width = 9,
                       boxPlus(title = "Add graph here",
                               width = 12,
                               status = "warning",
                               solidHeader = TRUE,
                               collapsible = FALSE,
                               closable = FALSE,
                               collapsed = FALSE)),
                column(width = 3,
                       box(
                         title = "Options",
                         status = 'warning',
                         solidHeader = TRUE,
                         width = 12,
                         collapsible = FALSE,
                         collapsed = FALSE,
                         pickerInput(
                           inputId = "st",
                           label = "Store:",
                           choices = unique(Stores$Store),
                           selected = "Store 1",
                           multiple = FALSE
                         ))))))))

server <- function(input, output) {
  observeEvent({
    input$YR
  },
  
  output$All <- renderPlotly({
    plot_ly(Stores[Stores$Year == input$YR,], x = ~Avg_cust, y = ~Sales,
            hoverinfo = "text", text = ~Store)%>%
      layout(title = "Store Performance",
             xaxis = list(title = "Customers"),
             yaxis = list(title = "Sales"))
  })
  )
  }

shinyApp(ui = ui, server = server)

Upvotes: 1

Views: 1288

Answers (1)

starja
starja

Reputation: 10365

Only using useShinyjs() doesn't do the trick. It only sets up shinyjs, but you need to tell it what to do. The idea here is to add the class "sidebar-collapse" to the body, as this hides the sidebar. The sidebar should always been hidden if a tab was switched, so have to add an observer that listens if a tab was switched. Then you can use shinyjs to add the class with addClass. The input of the tabswitch is the id of the sidebarMenu:

library(shiny)
library(dplyr)
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyjs)
library(shinyWidgets)
library(shinyBS)
library(plotly)

Stores <- data.frame(Store = c("Store 1", "Store 2", "Store 3", "Store 4", "Store 5"),
                     Sales = c(8247930, 423094, 204829, 903982, 7489472, 429085, 208955, 7492852, 5285034, 2958275,1598753, 28487593, 4892049, 583042, 509275, 5904728, 5098325, 5920947, 4920946, 2049583),
                     Avg_cust = c(325,542,582,482,904, 594, 304, 493, 690, 403, 694, 104, 493, 596, 403, 506, 304, 305, 632, 478),
                     Year = c(rep(2012,5), rep(2013,5), rep(2014,5), rep(2015,5)))

ui <- dashboardPage(
  header = dashboardHeader(
    title = "Store Performance"),
  sidebar = dashboardSidebar(
    width = 200,
    collapsed = FALSE,
    sidebarMenu(id = "tabs",
                menuItem("Page 1", tabName = "pg1"),
                menuItem("Page 2", tabName = "pg2"))),
  skin = "black",
  body = dashboardBody(
    useShinyjs(),
    tabItems(
      tabItem("pg1",
              fluidRow(
                column(width = 3,
                       box(
                         title = "Options",
                         status = 'warning',
                         solidHeader = TRUE,
                         width = 12,
                         collapsible = FALSE,
                         collapsed = FALSE,
                         pickerInput(
                           inputId = "YR",
                           label = "Year:",
                           choices = c(2012,2013,2014,2015),
                           selected = 2015,
                           multiple = FALSE))),
                column(width = 9,
                       box(plotlyOutput("All"),
                               status = 'warning',
                               width = 12,
                               solidHeader = TRUE,
                               collapsible = FALSE,
                               closable = FALSE,
                               collapsed = FALSE)))),
      tabItem("pg2",
              fluidRow(
                column(width = 9,
                       box(title = "Add graph here",
                               width = 12,
                               status = "warning",
                               solidHeader = TRUE,
                               collapsible = FALSE,
                               closable = FALSE,
                               collapsed = FALSE)),
                column(width = 3,
                       box(
                         title = "Options",
                         status = 'warning',
                         solidHeader = TRUE,
                         width = 12,
                         collapsible = FALSE,
                         collapsed = FALSE,
                         pickerInput(
                           inputId = "st",
                           label = "Store:",
                           choices = unique(Stores$Store),
                           selected = "Store 1",
                           multiple = FALSE
                         ))))))))

server <- function(input, output) {
  
  output$All <- renderPlotly({
    plot_ly(Stores[Stores$Year == input$YR,], x = ~Avg_cust, y = ~Sales,
            hoverinfo = "text", text = ~Store)%>%
      layout(title = "Store Performance",
             xaxis = list(title = "Customers"),
             yaxis = list(title = "Sales"))
  })
  
  observeEvent(input$tabs, {
    addClass(selector = "body", class = "sidebar-collapse")
  })
  
  
  
}

shinyApp(ui = ui, server = server)

BTW: you also need the package shinydashboardPlus. Also, I removed your observer because I don't know what you want to achieve. Lastly, I reduced the width of the header, because otherwise the button to show the sidebar is hidden.

For more information how it works, have a look here and here.

Upvotes: 1

Related Questions