R Shiny - タブ項目にナビゲートするときにサイドバーを自動的に非表示にする

Question

ここでは簡単な例を示します。タブ項目に移動するとサイドバーが動的に非表示になります。実際には、ユーザーは主に携帯端末でアプリに接続します。

ポスト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) 

Answer 1

私はあなたのsidebarmenu（注意：あなたが唯一の複数のmenuItemsと1 sidebarmenuを必要とする）にidを追加し、使用して、選択したタブの変化に耳を傾けるobserveEventidこと：

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

さて、いつでもあなたが他の1つのタブに切り替える、サイドバーが非表示になります。

希望すると便利です。