html - 在 ShinyDashboardPlus 中完全折叠左侧边栏

Question

ShinyDashboardPlus 具有左侧栏菜单折叠但仍显示图标的功能。这样做的问题是，它不会隐藏侧边栏中的任何按钮或输入选择。

我正在寻找以下两种解决方案之一:

1) 像常规 shinydashboard 一样完全折叠侧边栏(隐藏按钮和输入)

2) 保持左侧菜单按原样折叠，并在部分折叠时以某种方式隐藏这些功能

下面是我用来显示问题的代码:

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)

header <- dashboardHeaderPlus(
      enable_rightsidebar = TRUE,
      rightSidebarIcon = "filter"
    )

sidebar <- dashboardSidebar(
  sidebarMenu(id = "menuChoice",
              menuItem("Tab 1", tabName = "Tab1", icon = icon("globe"))
  ),
  actionButton("Test", "Download", icon = icon("download")),
  selectInput(inputId = "TestChoice",label = "Selection", selected="Choice1",
              choices = c("Choice1","Choice2","Choice3"))
)

body <- dashboardBody()

rightsidebar <- rightSidebar()

ui <- dashboardPagePlus(header, sidebar, body, rightsidebar)

server <- function(input, output) {}

shinyApp(ui, server)

Answer 1

我添加了一些 jquery 和 css 代码来模拟关闭侧边栏时 shinydashboard 的正常行为(解决方案 1)。

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)

jscode <- HTML("
$(document).on('shiny:connected', function(event) {
  $('.sidebar-toggle').on('click', function() {
    if ($('body')[0].className != 'skin-blue sidebar-mini sidebar-collapse') {
      $('#sidebarCollapsed').css('display', 'none')
    } else {
      $('#sidebarCollapsed').css('display', 'block')
    }
  })
});
")

csscode <- HTML("
.sidebar-mini.sidebar-collapse .content-wrapper {
      margin-left: 0px !important;
}")

header <- dashboardHeaderPlus(
  enable_rightsidebar = TRUE,
  rightSidebarIcon = "filter"
)

sidebar <- dashboardSidebar(collapsed = T,
  tags$head(tags$script(jscode)),
  tags$head(tags$style(csscode)),
  sidebarMenu(id = "menuChoice",
              menuItem("Tab 1", tabName = "Tab1", icon = icon("globe"))
  ),
  actionButton("Test", "Download", icon = icon("download")),
  selectInput(inputId = "TestChoice",label = "Selection", selected="Choice1",
              choices = c("Choice1","Choice2","Choice3"))
)
body <- dashboardBody()
rightsidebar <- rightSidebar()

ui <- dashboardPagePlus(header, sidebar, body, rightsidebar)

###########################/server.R/###############################
server <- function(input, output) {}

#Combines Dasboard and Data together----
shinyApp(ui, server)

使用一些 css 可以实现解决方案 2，尽管您可能必须根据自己的喜好添加或调整一些 css:

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)

csscode <- HTML("
.sidebar-mini.sidebar-collapse .shiny-bound-input.action-button {
  margin: 6px 6px 6px 3px;
  max-width: 85%;
}
.sidebar-mini.sidebar-collapse .fa {
  font-size: initial;
}
.sidebar-mini.sidebar-collapse .btn-default {
  font-size: 0;
}
.sidebar-mini.sidebar-collapse #tohide {
  display: none;
}
")

header <- dashboardHeaderPlus(
  enable_rightsidebar = TRUE,
  rightSidebarIcon = "filter"
)

sidebar <- dashboardSidebar(collapsed = T,
                            tags$head(tags$style(csscode)),
                            sidebarMenu(id = "menuChoice",
                                        menuItem("Tab 1", tabName = "Tab1", icon = icon("globe"))
                            ),
                            actionButton("Test", "Download", icon = icon("download")),
                            div(id="tohide", 
                              selectInput(inputId = "TestChoice",label = "Selection", selected="Choice1",
                                          choices = c("Choice1","Choice2","Choice3"))
                                )
)

body <- dashboardBody()

rightsidebar <- rightSidebar()

ui <- dashboardPagePlus(header, sidebar, body, rightsidebar)

server <- function(input, output) {}

shinyApp(ui, server)