R Shiny - Automatically hide the sidebar when you navigate into tab items

问题

I have a Shiny app - simplified example here - and I want the sidebar to hide dynamically when I navigate into tab items. Indeed users will connect to the app mainly with their mobile.

With the help of the post Hide sidebar in default in shinydashboard, I know how to hide by default the sidebar when you arrive on the app, but after the sidebar is always displayed.

Here is my actual code :

### Load librairies
library(shiny) ; library(shinydashboard) ; library(shinyjs)
library(dplyr)

### Load data
Weather <- c("cold", "rain", "snow","heat","sun")
Answer <- c("Take a coat","Take an umbrella","Take gloves","Take a swimsuit","Take solair cream")
Mydata <- data.frame( Weather, Answer, stringsAsFactors = FALSE)

remove(Weather, Answer)

### Shiny
Entete <- dashboardHeader(title = "My app")

BarreLaterale <- dashboardSidebar(
  sidebarMenu(menuItem(text = "Home", tabName = "MyHome", icon = icon("home"))),
  sidebarMenu(menuItem(text = "My search", tabName = "Search", icon = icon("search")))
  )

Corps <- dashboardBody(

  useShinyjs(),

  tabItems(

    tabItem(tabName = "MyHome",
            fluidPage("Hello, welcome to the home page")
    ),        

    tabItem(tabName = "Search",
            fluidRow(
              box(title = "Weather choice",  width = 6, solidHeader = TRUE, status = "danger",
                  selectInput(inputId = "WeatherChoice", label = NULL, choices = unique(Mydata$Weather))),
              box(title = "Answer", width = 6, solidHeader = TRUE, status = "danger",
                  textOutput("ReturnAnswer"))
            )
    )

  )  
)

Interface <- dashboardPage(Entete, BarreLaterale, Corps, skin = "red")

### Server R
Serveur <- function(input, output, session) {

  output$ReturnAnswer <- renderText({
    as.character(Mydata %>% filter(Weather == input$WeatherChoice) %>% select(Answer))
  })

  addClass(selector = "body", class = "sidebar-collapse")

}

### Application
shinyApp(Interface, Serveur)

回答1:

I added an id to your sidebarmenu (Note: you only need one sidebarmenu with multiple menuItems), and an observeEvent to listen to changes in the selected tab, using that id:

### Load librairies
library(shiny) ; library(shinydashboard) ; library(shinyjs)
library(dplyr)

### Load data
Weather <- c("cold", "rain", "snow","heat","sun")
Answer <- c("Take a coat","Take an umbrella","Take gloves","Take a swimsuit","Take solair cream")
Mydata <- data.frame( Weather, Answer, stringsAsFactors = FALSE)

remove(Weather, Answer)

### Shiny
Entete <- dashboardHeader(title = "My app")

BarreLaterale <- dashboardSidebar(
  sidebarMenu(id="mysidebar",
                menuItem(text = "Home", tabName = "MyHome", icon = icon("home")),
              menuItem(text = "My search", tabName = "Search", icon = icon("search")))
)

Corps <- dashboardBody(

  useShinyjs(),

  tabItems(

    tabItem(tabName = "MyHome",
            fluidPage("Hello, welcome to the home page")
    ),        

    tabItem(tabName = "Search",
            fluidRow(
              box(title = "Weather choice",  width = 6, solidHeader = TRUE, status = "danger",
                  selectInput(inputId = "WeatherChoice", label = NULL, choices = unique(Mydata$Weather))),
              box(title = "Answer", width = 6, solidHeader = TRUE, status = "danger",
                  textOutput("ReturnAnswer"))
            )
    )

  )  
)

Interface <- dashboardPage(Entete, BarreLaterale, Corps, skin = "red")

### Server R
Serveur <- function(input, output, session) {

  output$ReturnAnswer <- renderText({
    as.character(Mydata %>% filter(Weather == input$WeatherChoice) %>% select(Answer))
  })

  # this line is now actually obsolete.
  addClass(selector = "body", class = "sidebar-collapse")

  observeEvent(input$mysidebar,
               {
                 # for desktop browsers
                 addClass(selector = "body", class = "sidebar-collapse")
                 # for mobile browsers
                 removeClass(selector = "body", class = "sidebar-open")
               })

### Application
shinyApp(Interface, Serveur)

Now, any time you switch from one tab to the other, the sidebar is hidden again.

Hope this helps!

来源：https://stackoverflow.com/questions/47830553/r-shiny-automatically-hide-the-sidebar-when-you-navigate-into-tab-items

标签

Shiny

shinydashboard

shinyjs