我添加了一个
id
到您的
sidebarmenu
(注意:您只需要一个
侧栏菜单
具有多个
menuItems
),和
observeEvent
要侦听所选选项卡中的更改,请使用
身份证件
:
### 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)
现在,无论何时从一个选项卡切换到另一个选项卡,侧栏都会再次隐藏。
希望这有帮助!