ShinyDashboardPlus
has a feature where the left sidebar menu collapses but still shows the icon. The issue with this is, it doesn't hide any buttons or input selections placed in the sidebar.
I am looking for either the below 2 solutions:
1) To collapse the sidebar fully like in regular shinydashboard
(which hides the button & inputs)
2) To keep the leftside menu collapse as is and somehow hide these features when collapsing partially
Below is my code to show the issue:
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
header <- dashboardHeaderPlus(
enable_rightsidebar = TRUE,
rightSidebarIcon = "filter"
)
sidebar <- dashboardSidebar(
sidebarMenu(id = "menuChoice",
menuItem("Tab 1", tabName = "Tab1", icon = icon("globe"))
),
actionButton("Test", "Download", icon = icon("download")),
selectInput(inputId = "TestChoice",label = "Selection", selected="Choice1",
choices = c("Choice1","Choice2","Choice3"))
)
body <- dashboardBody()
rightsidebar <- rightSidebar()
ui <- dashboardPagePlus(header, sidebar, body, rightsidebar)
server <- function(input, output) {}
shinyApp(ui, server)
I added some jquery and css code to simulate the normal behaviour of shinydashboard when closing the sidebar (Solution 1).
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
jscode <- HTML("
$(document).on('shiny:connected', function(event) {
$('.sidebar-toggle').on('click', function() {
if ($('body')[0].className != 'skin-blue sidebar-mini sidebar-collapse') {
$('#sidebarCollapsed').css('display', 'none')
} else {
$('#sidebarCollapsed').css('display', 'block')
}
})
});
")
csscode <- HTML("
.sidebar-mini.sidebar-collapse .content-wrapper {
margin-left: 0px !important;
}")
header <- dashboardHeaderPlus(
enable_rightsidebar = TRUE,
rightSidebarIcon = "filter"
)
sidebar <- dashboardSidebar(collapsed = T,
tags$head(tags$script(jscode)),
tags$head(tags$style(csscode)),
sidebarMenu(id = "menuChoice",
menuItem("Tab 1", tabName = "Tab1", icon = icon("globe"))
),
actionButton("Test", "Download", icon = icon("download")),
selectInput(inputId = "TestChoice",label = "Selection", selected="Choice1",
choices = c("Choice1","Choice2","Choice3"))
)
body <- dashboardBody()
rightsidebar <- rightSidebar()
ui <- dashboardPagePlus(header, sidebar, body, rightsidebar)
###########################/server.R/###############################
server <- function(input, output) {}
#Combines Dasboard and Data together----
shinyApp(ui, server)
And with some css you can achieve Solution 2, although you might have to add or adjust some css to your preferences:
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
csscode <- HTML("
.sidebar-mini.sidebar-collapse .shiny-bound-input.action-button {
margin: 6px 6px 6px 3px;
max-width: 85%;
}
.sidebar-mini.sidebar-collapse .fa {
font-size: initial;
}
.sidebar-mini.sidebar-collapse .btn-default {
font-size: 0;
}
.sidebar-mini.sidebar-collapse #tohide {
display: none;
}
")
header <- dashboardHeaderPlus(
enable_rightsidebar = TRUE,
rightSidebarIcon = "filter"
)
sidebar <- dashboardSidebar(collapsed = T,
tags$head(tags$style(csscode)),
sidebarMenu(id = "menuChoice",
menuItem("Tab 1", tabName = "Tab1", icon = icon("globe"))
),
actionButton("Test", "Download", icon = icon("download")),
div(id="tohide",
selectInput(inputId = "TestChoice",label = "Selection", selected="Choice1",
choices = c("Choice1","Choice2","Choice3"))
)
)
body <- dashboardBody()
rightsidebar <- rightSidebar()
ui <- dashboardPagePlus(header, sidebar, body, rightsidebar)
server <- function(input, output) {}
shinyApp(ui, server)
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With