我有一个Shiny应用程序 - 简化示例 - 我希望侧边栏在导航到标签项时动态隐藏。事实上,用户将主要通过手机连接到应用程序。
在帖子Hide sidebar in default in 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)
答案 0 :(得分:2)
我在id
添加了sidebarmenu
(注意:您只需要一个sidebarmenu
多个menuItems
),observeEvent
来收听更改在所选标签中,使用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)
现在,只要您从一个标签切换到另一个标签,侧边栏就会再次隐藏。
希望这有帮助!