lmsimp
Reputation: 932
shinydashboardPlus fix conflicting css between sidebars
I am using the package shinydashboardPlus and would like to have two features in my dashboard-
- Fully collapse the left and right sidebars
- Both sidebars to be open on startup
In the example code below I am able to achieve (1) by adding the argument sidebar_fullCollapse = TRUE to dashboardPagePlus.
To achieve (2) I used the suggestion from this post and added a tag to the body to enforce it open at startup e.g tags$body(class="skin-blue sidebar-mini control-sidebar-open", dashboardPagePlus(...).
When I try and do this with (1) I find the left menu no longer fully collapses. e.g.
Can someone please help me out with my conflicting css to fix this?
Example
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
Upvotes: 0
Views: 439
Answers (1)
Mriti Agarwal
Reputation: 216
Here is the solution to your problem. It was just a single word "right" before the "sidebar" in the main ui assignment tag that made all the difference.
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)
Upvotes: 1
Related Questions
- Change the color of left and right sidebar in shinydashboardPlus when using bs4Dash package
- Remove redundant space that appears when the width of the rightsidebar in shinydashboardPlus is changed
- Collapse Left Sidebar fully in ShinyDashboardPlus
- Stop the right sidebar in shinydashboardPlus from hiding the body of the app
- Remove the left sidebar in shinydashboardPlus (keep only the right)
- Remove the dark space at the top of the right sidebar in a shinydashboardPlus
- Shinydashboard: Make sidebarPanel overlay over mainPanel
- R Shiny - Fixed sidebar and main header in a Shiny dashboard
- R & Shiny - Sidebar text alignment justified
- shinydashboard Sidebar Menu Overflow