Shinydashboard Plus修复了侧边栏之间冲突的CSS

2022-08-30 00:00:00 r shiny css shinydashboard

我正在使用包shinydashboardPlus,并希望在我的仪表板中具有两个功能-

  1. 完全折叠左右侧边栏
  2. 启动时打开两个侧边栏

在下面的示例代码中,我能够实现(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)

相关文章