All geek questions in one place

R Shiny - automatically hide the sidebar when navigating tabs

I have an example of a simplified Shiny application - and I want the sidebar to hide dynamically when I move to tabs. Indeed, users will connect to the application mainly with their mobile phone.

Using post Hide the default sidebar in shinydashboard , I know how to hide the default sidebar when I come to the application, but it always appears after the sidebar.

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)
+5
source share
1 answer

I added an id to your sidebarmenu (Note: you only need one sidebarmenu with several menuItems ) and observeEvent to listen to the changes on the selected tab using 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, when you switch from one tab to another, the sidebar is hiding again.

Hope this helps!

+1
source

Source: https://habr.com/ru/post/1274094/

More articles:


All Articles