Shinydashboard Plus修复了侧边栏之间冲突的CSS
我正在使用包shinydashboardPlus，并希望在我的仪表板中具有两个功能-
- 完全折叠左右侧边栏
- 启动时打开两个侧边栏
在下面的示例代码中，我能够实现(1)将参数sidebar_fullCollapse = TRUE添加到dashboardPagePlus。
为了实现(2)，我使用了this post中的建议，并在正文中添加了一个标记以强制其在启动时打开，例如tags$body(class="skin-blue sidebar-mini control-sidebar-open", dashboardPagePlus(...)。
当我尝试使用(1)执行此操作时，我发现左侧菜单不再完全折叠。例如
有人能帮我解决我的冲突css来解决这个问题吗？
示例
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyWidgets)
data(iris)
mychoices <- c("pick me A",
"pick me - a very long name here",
"no pick me - B",
"another one that is long")
## my css
CSS <- function(colors){
template <- "
.checkboxGroupButtons div.btn-group:nth-child(%s) button {
background: %s !important;
color: black !important;
padding: 5px;
margin-bottom: 8px
}"
paste0(
apply(cbind(seq_along(colors), colors), 1, function(vc){
sprintf(template, vc[1], vc[2])
}),
collapse = "
"
)
}
cols <- c("red", "blue", "yellow", "green")
mycss <- CSS(cols)
# ui <- tagList(
header <- dashboardHeaderPlus(enable_rightsidebar = TRUE,
rightSidebarIcon = "filter")
sidebar <- dashboardSidebar(
p(strong("Classes")),
actionButton(inputId = "selectall", label="Select/Deselect all",
style='padding:12px; font-size:80%'),
br(), br(),
checkboxGroupButtons(
inputId = "classes",
choices = mychoices,
selected = mychoices,
direction = "vertical",
width = "100%",
size = "xs",
checkIcon = list(
yes = icon("ok",
lib = "glyphicon"))
)
)
body <- dashboardBody(
tags$script('
$(".navbar-custom-menu").on("click",function(){
$(window).trigger("resize");
})'
),
tags$head(tags$style(HTML('
/* logo */
.skin-blue .main-header .logo {
background-color: #808080;
}
/* logo when hovered */
.skin-blue .main-header .logo:hover {
background-color: #FFFFFF;
}
/* navbar (rest of the header) */
.skin-blue .main-header .navbar {
background-color: #C0C0C0;
}
/* main sidebar */
.skin-blue .main-sidebar {
background-color: #FFFFFF;
}
/* body */
.content-wrapper, .right-side {
background-color: #FFFFFF;
}
'))),
tags$head(tags$style(HTML(mycss))),
tabsetPanel(type = "tabs",
tabPanel("Scatter", id = "panel1",
plotOutput(outputId = "scatter")),
tabPanel("PCA", id = "panel2"))
)
rightsidebar <- rightSidebar(background = "light",
width = 150,
.items = list(
p(strong("Controls")),
br(),
p("Transparancy"),
sliderInput("trans", NULL,
min = 0, max = 1, value = .5),
actionButton("resetButton", "Zoom/reset plot",
style='padding:6px; font-size:80%'),
br(), br(),
actionButton("clear", "Clear selection",
style='padding:6px; font-size:80%'),
br(), br(),
actionButton("resetColours", "Reset colours",
style='padding:6px; font-size:80%'),
br())
)
ui <- tags$body(class="skin-blue sidebar-mini control-sidebar-open", dashboardPagePlus(header,
sidebar,
body,
rightsidebar,
sidebar_fullCollapse = TRUE))
shinyUI(tagList(ui))
## server side
server <- function(input, output) {
output$scatter <- renderPlot({
plot(iris$Petal.Length, iris$Petal.Width, pch=21)
cats <- levels(iris$Species)
cols <- c("red", "blue", "yellow2")
ind <- lapply(cats, function(z) which(iris$Species == z))
for (i in seq(cats)) {
points(iris$Petal.Length[ind[[i]]], iris$Petal.Width[ind[[i]]],
pch = 19, col = cols[i])
}
})
}
## run app
shinyApp(ui, server)
essionInfo()
R version 4.0.2 (2020-06-22)
Platform: x86_64-apple-darwin17.0 (64-bit)
Running under: macOS Catalina 10.15.6
Matrix products: default
BLAS: /System/Library/Frameworks/Accelerate.framework/Versions/A/Frameworks/vecLib.framework/Versions/A/libBLAS.dylib
LAPACK: /Library/Frameworks/R.framework/Versions/4.0/Resources/lib/libRlapack.dylib
locale:
[1] en_GB.UTF-8/en_GB.UTF-8/en_GB.UTF-8/C/en_GB.UTF-8/en_GB.UTF-8
attached base packages:
[1] stats4 parallel stats graphics grDevices utils datasets methods base
other attached packages:
[1] shinydashboardPlus_0.7.5 shinydashboard_0.7.1 shinyWidgets_0.5.3 dendextend_1.14.0 tidyr_1.1.2
[6] patchwork_1.0.1 ggplot2_3.3.2 shinyhelper_0.3.2 colorspace_1.4-1 colourpicker_1.1.0
[11] shinythemes_1.1.2 DT_0.15 dplyr_1.0.2 shiny_1.5.0 MSnbase_2.14.2
[16] ProtGenerics_1.20.0 S4Vectors_0.26.1 mzR_2.22.0 Rcpp_1.0.5 Biobase_2.48.0
[21] BiocGenerics_0.34.0
解决方案
这是您问题的解决方案。造成所有差异的只是主用户界面分配标记中的"；侧边栏"；前面的一个单词。
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyWidgets)
data(iris)
mychoices <- c("pick me A",
"pick me - a very long name here",
"no pick me - B",
"another one that is long")
## my css
CSS <- function(colors){
template <- "
.checkboxGroupButtons div.btn-group:nth-child(%s) button {
background: %s !important;
color: black !important;
padding: 5px;
margin-bottom: 8px
}"
paste0(
apply(cbind(seq_along(colors), colors), 1, function(vc){
sprintf(template, vc[1], vc[2])
}),
collapse = "
"
)
}
cols <- c("red", "blue", "yellow", "green")
mycss <- CSS(cols)
# ui <- tagList(
header <- dashboardHeaderPlus(enable_rightsidebar = TRUE,
rightSidebarIcon = "filter")
sidebar <- dashboardSidebar(
p(strong("Classes")),
actionButton(inputId = "selectall", label="Select/Deselect all",
style='padding:12px; font-size:80%'),
br(), br(),
checkboxGroupButtons(
inputId = "classes",
choices = mychoices,
selected = mychoices,
direction = "vertical",
width = "100%",
size = "xs",
checkIcon = list(
yes = icon("ok",
lib = "glyphicon"))
)
)
body <- dashboardBody(
tags$script('
$(".navbar-custom-menu").on("click",function(){
$(window).trigger("resize");
})'
),
tags$head(tags$style(HTML('
/* logo */
.skin-blue .main-header .logo {
background-color: #808080;
}
/* logo when hovered */
.skin-blue .main-header .logo:hover {
background-color: #FFFFFF;
}
/* navbar (rest of the header) */
.skin-blue .main-header .navbar {
background-color: #C0C0C0;
}
/* main sidebar */
.skin-blue .main-sidebar {
background-color: #FFFFFF;
}
/* body */
.content-wrapper, .right-side {
background-color: #FFFFFF;
}
'))),
tags$head(tags$style(HTML(mycss))),
tabsetPanel(type = "tabs",
tabPanel("Scatter", id = "panel1",
plotOutput(outputId = "scatter")),
tabPanel("PCA", id = "panel2"))
)
rightsidebar <- rightSidebar(background = "light",
width = 150,
.items = list(
p(strong("Controls")),
br(),
p("Transparancy"),
sliderInput("trans", NULL,
min = 0, max = 1, value = .5),
actionButton("resetButton", "Zoom/reset plot",
style='padding:6px; font-size:80%'),
br(), br(),
actionButton("clear", "Clear selection",
style='padding:6px; font-size:80%'),
br(), br(),
actionButton("resetColours", "Reset colours",
style='padding:6px; font-size:80%'),
br())
)
ui <- tags$body(class="skin-blue right-sidebar-mini control-sidebar-open", dashboardPagePlus(header,
sidebar,
body,
rightsidebar,
sidebar_fullCollapse = TRUE))
shinyUI(tagList(ui))
## server side
server <- function(input, output) {
output$scatter <- renderPlot({
plot(iris$Petal.Length, iris$Petal.Width, pch=21)
cats <- levels(iris$Species)
cols <- c("red", "blue", "yellow2")
ind <- lapply(cats, function(z) which(iris$Species == z))
for (i in seq(cats)) {
points(iris$Petal.Length[ind[[i]]], iris$Petal.Width[ind[[i]]],
pch = 19, col = cols[i])
}
})
}
## run app
shinyApp(ui, server)
相关文章