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)
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!
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With