Reputation: 932
I am using shinydashboardPlus
and wish to change the width of the right sidebar which I know can be done specifying the width
argument in the call to the rightSidebar
function, however when I do this (as per the below example taken from here) redundant space appears next to the right menu (see the dark grey column/space next to the right menu in the below screenshot).
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 <- 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)
My hunch is that I need to change the background colour of some element in the app as this grey colour is the default theme colour for shinydashboardPlus
(you can see I have changed this to white using a bit of css
).
What I would like to achieve is this (but a smaller width for the right menu) - this is the output when width
is not specified and the default value is used.
sessionInfo()
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] shinyWidgets_0.5.3 dendextend_1.14.0 tidyr_1.1.2
[4] patchwork_1.0.1 ggplot2_3.3.2 shinyhelper_0.3.2
[7] colorspace_1.4-1 colourpicker_1.1.0 shinythemes_1.1.2
[10] DT_0.15 dplyr_1.0.2 shinydashboardPlus_0.7.5
[13] shinydashboard_0.7.1 shiny_1.5.0 MSnbase_2.14.2
[16] ProtGenerics_1.20.0 S4Vectors_0.26.1 mzR_2.22.0
[19] Rcpp_1.0.5 Biobase_2.48.0 BiocGenerics_0.34.0
Upvotes: 5
Views: 458
Reputation: 3888
After some digging I found that the error is rising from the 7nth line of the AdminLTE.min.css
file in which it gives a 230px
right margin to the open control sidebar and 230px
is the default width :
.control-sidebar-open .content-wrapper, .control-sidebar-open .main-footer, .control-sidebar-open .right-side {
margin-right: 230px;
}
this margin needs to be equal to the chosen width one workaround would be to use this pastecss(..., width)
function that's just a wrapper to paste0
but appends the edited css that give the control-bar
the right margin:
pastecss <- function(..., width) paste0(...,'\n', ' .control-sidebar-open .content-wrapper,.control-sidebar-open .main-footer,.control-sidebar-open .right-side{
margin-right:',width,'px
}')
and then call it when creating the body element:
body <- dashboardBody(
tags$script('
$(".navbar-custom-menu").on("click",function(){
$(window).trigger("resize");
})'
),
tags$head(tags$style(HTML(pastecss('
/* 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;
}
',width= 150)))),
tags$head(tags$style(HTML(mycss))),
tabsetPanel(type = "tabs",
tabPanel("Scatter", id = "panel1",
plotOutput(outputId = "scatter")),
tabPanel("PCA", id = "panel2"))
)
Another way and I will push this to the github repo is overloading the rightSidebar function :
rightSidebar <- function(..., background = "dark", width = 230, .items = NULL) {
panels <- list(...)
sidebarTag <- shiny::tags$div(
id = "controlbar",
shiny::tags$aside(
class = paste0("control-sidebar control-sidebar-", background),
style = paste0("width: ", width, "px;"),
# automatically create the tab menu
if (length(panels) > 0) shinydashboardPlus:::rightSidebarTabList(shinydashboardPlus:::rigthSidebarPanel(...)),
if (length(panels) > 0) shinydashboardPlus:::rigthSidebarPanel(...) else shinydashboardPlus:::rigthSidebarPanel(.items)
),
# Add the sidebar background. This div must be placed
# immediately after the control sidebar
shiny::tags$div(class = "control-sidebar-bg", style = paste0("width: ", width, "px;"))
)
shiny::tagList(
shiny::singleton(
shiny::tags$head(
# custom css to correctly handle the width of the rightSidebar
shiny::tags$style(
shiny::HTML(
paste0(
".control-sidebar-bg,
.control-sidebar {
top: 0;
right: ", -width, "px;
width: ", width, "px;
-webkit-transition: right 0.3s ease-in-out;
-o-transition: right 0.3s ease-in-out;
transition: right 0.3s ease-in-out;
}
.control-sidebar-open .content-wrapper,.control-sidebar-open .main-footer,.control-sidebar-open .right-side{
margin-right:",width,"px
}"
)
)
)
)
),
sidebarTag
)
}
And then executing it after loading shinydashboardPlus
to avoid conflicts and then executing your code like you'd normally do.
Upvotes: 3