Stop the right sidebar in shinydashboardPlus from hiding the body of the app

问题

is it possible to stop the right hand sidebar in shinydashboardPlus from hiding part of the main body the app?

The default behaviour for a regular left sidebar panel is not to hide any part of the main body of the app. For example, in the below the left sidebar is clicked and the plot is moved to the right (you can see all parts of the plot).

With the right sidebar panel is clicked this behaviour does not happen (see below screenshot).

The sidebar is clicked and the plot is partially hidden by the panel. How can I stop this behaviour and make it so that once clicked the plot is moved left/rescaled to fit the body so that I don't hide part of the plot?

Example code

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
data(iris)

header <- dashboardHeaderPlus(
  enable_rightsidebar = TRUE,
  rightSidebarIcon = "filter"
)

sidebar <- dashboardSidebar(selectInput(inputId = "slect",
                                        label = "Selection Menu", 
                                        selected = "a",
                                        choices = LETTERS[1:3])
)

body <- dashboardBody(fluidPage(plotOutput( "scatter", 
                                  height = "700px", 
                                  width = "700px")))

rightsidebar <- rightSidebar()

ui <- dashboardPagePlus(header, 
                        sidebar, 
                        body, 
                        rightsidebar)

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])
      }
    })
}

shinyApp(ui, server)

Session info:

> sessionInfo()
R version 4.0.0 (2020-04-24)
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.13.4       
 [5] tidyr_1.1.0              patchwork_1.0.1          ggplot2_3.3.1            shinyhelper_0.3.2       
 [9] colorspace_1.4-1         colourpicker_1.0         shinythemes_1.1.2        DT_0.13                 
[13] shiny_1.4.0.2            dplyr_1.0.0              MSnbase_2.14.2           ProtGenerics_1.20.0     
[17] S4Vectors_0.26.1         mzR_2.22.0               Rcpp_1.0.4.6             Biobase_2.48.0          
[21] BiocGenerics_0.34.0

回答1:

The 1st problem is, that plotOutput shouldn't have a fixed width of 700px if you're expecting it to resize.

The second issue is, that clicking the right sidebar doesn't trigger a resize event (same issue as here) for shinydashboard's left sidebar. I fixed it via JS:

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
data(iris)

header <- dashboardHeaderPlus(enable_rightsidebar = TRUE,
                              rightSidebarIcon = "filter")

sidebar <- dashboardSidebar(
  selectInput(
    inputId = "slect",
    label = "Selection Menu",
    selected = "a",
    choices = LETTERS[1:3]
  )
)

body <- dashboardBody(
  tags$script('
      $(".navbar-custom-menu").on("click",function(){
        $(window).trigger("resize");
      })'
  ),
  fluidPage(
    plotOutput(
      "scatter",
      height = "700px",
      width = "100%"
    )
  ))

rightsidebar <- rightSidebar()

ui <- dashboardPagePlus(header,
                        sidebar,
                        body,
                        rightsidebar)

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])
    }
  })
}

shinyApp(ui, server)

来源：https://stackoverflow.com/questions/63832380/stop-the-right-sidebar-in-shinydashboardplus-from-hiding-the-body-of-the-app

标签

css

Shiny

shinydashboard