ShinydashboardPlus修复侧边栏之间冲突的CSS
我正在使用软件包shinydashboardPlus，并且希望在我的仪表板中具有两个功能-
- 完全折叠左右侧边栏
- 两个侧边栏都将在启动时打开
在下面的示例代码中，我可以通过将参数sidebar_fullCollapse = TRUE添加到dashboardPagePlus来实现（1）。
要实现（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 = "\n"
)
}
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
1 个答案:
答案 0 :(得分：1)
这是您的问题的解决方案。唯一的区别就是主ui分配标签中“侧边栏”之前的一个单词“正确”。
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 = "\n"
)
}
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)
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？