在ShinyBashboardPlus中完全折叠左侧栏

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)

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. 不会折叠页眉中的仪表板标题