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代码，以模拟关闭侧栏(解决方案1)时shinydashboard的正常行为。

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)

Answer 2

正如前面提到的这里，您可以使用shinydashboardPlus::dashboardPagePlus()函数的sidebar_fullCollapse = TRUE参数，例如：

shinyApp(
  ui = dashboardPagePlus(
    header               = dashboardHeaderPlus(),
    sidebar              = dashboardSidebar(),
    sidebar_fullCollapse = TRUE,
    body                 = dashboardBody(),
  ),
  server = function(input, output) { }
)

这是：

1. 完全折叠侧边栏，因此没有留下图标；
2. 不会折叠标题中的仪表板标题。