代码之家  ›  专栏  ›  技术社区  ›  Kumpelka

R Shiny-在导航到选项卡项时自动隐藏侧栏

  •  6
  • Kumpelka  · 技术社区  · 7 年前

    我有一个闪亮的应用程序-这里有一个简化的示例-我希望侧栏在导航到选项卡项时动态隐藏。实际上,用户将主要通过手机连接到应用程序。

    在邮局的帮助下 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)
    
    1 回复  |  直到 7 年前
        1
  •  3
  •   Florian    7 年前

    我添加了一个 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)
    

    现在,无论何时从一个选项卡切换到另一个选项卡,侧栏都会再次隐藏。

    希望这有帮助!