r闪亮 - 当您导航到标签项目时，会自动隐藏侧边栏

Question

我有一个闪亮的应用程序 - 简化的示例 - 我希望侧栏在导航到选项卡项目时动态隐藏。确实，用户将主要通过其手机连接到该应用程序。

借助ShinyDashboard的默认情况下隐藏的侧边栏，我知道如何在到达应用程序上时默认情况下隐藏侧边栏，但是在始终显示侧栏后。

>

这是我的实际代码：

### 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)

Answer 1

我在您的sidebarmenu中添加了id（注意：您只需要一个带有多个menuItems的sidebarmenu），然后使用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)

现在，每当您从一个选项卡切换到另一个选项卡时，侧栏都会再次隐藏。

希望这会有所帮助！