disabling/enabling sidebar from server side - r

Is there any way to manually disabling/enabling the sidebar on shiny dashboard app from the server side?
I would like to hide the sidebar automatically when I need more space without using toggle button on the header.
Thank you

I'm not very familiar with dashboards as I never built one, but from a taking a quick look, it seems like when clicking on the open/hide sidebar button, all that happens is a sidebar-collapse class gets added/removed to the <body> tag. Maybe more things happen that I'm unaware of, but that seemed to be the most visible thing.
So you can easily use shinyjs package (disclaimer: I'm the author) to add/remove that class
library(shiny)
library(shinydashboard)
library(shinyjs)
shinyApp(
ui =
dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
shinyjs::useShinyjs(),
actionButton("showSidebar", "Show sidebar"),
actionButton("hideSidebar", "Hide sidebar")
)
),
server = function(input, output, session) {
observeEvent(input$showSidebar, {
shinyjs::removeClass(selector = "body", class = "sidebar-collapse")
})
observeEvent(input$hideSidebar, {
shinyjs::addClass(selector = "body", class = "sidebar-collapse")
})
}
)

Related

Toggle display of sidebar menu in shinydashboard programmatically

I am working with R shiny dashboard and was wondering if I can collapse/show the sidebar with an additional button, just like the already existing one on top of the sidebar.
Is that possible?
Cheers
You can add / remove the needed css class to / from the body via shinyjs:
library(shiny)
library(shinyjs)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
shinyjs::useShinyjs(),
actionButton("toggle_btn", "Toggle sidebar")
)
)
server <- function(input, output, session) {
observeEvent(input$toggle_btn, {
shinyjs::toggleClass(selector = "body", class = "sidebar-collapse")
})
}
shinyApp(ui, server)

How to Disable Shiny bs4Dash Dashboard controlbar (Right Sidebar)

What is the parameter to control the right side bar on a Shiny bs4Dash dashboard. My reading of the dashboardControlbar function at https://rinterface.github.io/bs4Dash/articles/step-by-step.html, which I understand to be the sidebar to the right of the page, is to set disable = T, in a similar way to how the dashboardSidebar(disable = T) controls the appearance sidebar to the left.
I have set controlbar = dashboardControlbar(disable = T) however on the Shiny App below and the right sidebar still opens when pressing the button at the top. Thanks for any suggestions in advance.
Edit (in response to dashboardHeader comment ):
This question is in reference to bs4Dash V2.0.0 available via github.
https://github.com/RinteRface/bs4Dash
Please note that the github page also recommends github versions of htmltools and shiny.
library(shiny)
library(bs4Dash)
ui = dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(
disable = T
),
body = dashboardBody(),
controlbar = dashboardControlbar(
disable = T
),
title = ""
)
server <- function(input, output, session) {}
shinyApp(ui, server)
You can remove controlbar argument to disable it.
library(shiny)
library(bs4Dash)
ui = dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(
disable = T
),
body = dashboardBody(),
title = ""
)
server <- function(input, output, session) {}
shinyApp(ui, server)

daterangeinput without fluidpage in shiny dashboard

I have an issue while creating a shiny web app using semantic.dashboard library.
Below is the code for my app.
library(semantic.dashboard)
# Define UI
header <- dashboardHeader(
)
sidebar <- dashboardSidebar(
side = "left",
sidebarMenu(
menuItem(tabName = "overview", text = "Overview", icon = icon("home")),
menuItem(tabName = "analysis", text = "Analysis", icon = icon("chart bar"))
)
)
body <- dashboardBody(
dateRangeInput("datepicker", NULL, start = Sys.Date()-30, end = Sys.Date()-1)
)
tabItems(
tabItem(
tabName = "overview",
fluidRow(
)
),
tabItem(
tabName = "analysis",
fluidRow(
)
)
)
ui <- dashboardPage(
header,
sidebar,
body,
title = "My Dashboard",
theme = "lumen"
)
# Define server logic
server <- function(input, output, session) {
session$onSessionEnded(stopApp)
}
# Run the application
shinyApp(ui = ui, server = server)
The result is in the screenshot below:
The main problem is that the dates inside the daterangeinput widget are just like simple text inside textbox.
I can't click on them to change the dates.
Using fluidPage() would resolve the problem, but the whole web page isn't filled totally by the app (and for this app, responsiveness isn't really useful).
Below is the screenshot of the app when I use fluidPage(), you can see that there's so much space between the sidebar and the border, and beetween the sidebar and the body.
app with fluidPage()
I'd like to know if it's possible to use daterangeinput without using fluidPage() or, if not possible, know how to remove the padding between the border and the sidebar when using fluidPage.
Thanks in advance for your help.
Above example doesn't work because it uses bootstrap framework styles - contrary to shiny.semantic or semantic.dashboard packages.
Please check my PR to shiny.semantic package. I've implemented there simple date input with usage of semantic-ui components. You can also use it to create simple date range (added quick example in PR).

Shinydashboard remove extra space when header is disabled

The whole code/files can be found in this answer
UI.R file
library(shiny)
library(shinydashboard)
shinyUI(
dashboardPage(
dashboardHeader(disable = TRUE), #title=textOutput("title")),
dashboardSidebar(uiOutput("side")),
dashboardBody(
uiOutput("page")
)))
However, I want to disable header in my dashboard, with help from here I managed to disable but then there is some white space added in my dashboard. (see image, the orange highlighed box).
How can I get rid of this? This is not only on login page, the problem persist even after logged in.
I think that it is a missing feature on shiny dashboard to automatically add to the body the height of the header. I fixed it with a trick using JavaScript. The solution is based on add 50px to the CSS min-height attribute of body just after creating the page. Also I added an event listener to add the 50px if the size of the window changes.
library(shiny)
library(shinydashboard)
server <- function(input, output) {
}
ui <- dashboardPage(
dashboardHeader(disable = TRUE),
dashboardSidebar(),
dashboardBody(
tags$script('window.onload = function() {
function fixBodyHeight() {
var el = $(document.getElementsByClassName("content-wrapper")[0]);
var h = el.height();
el.css("min-height", h + 50 + "px");
};
window.addEventListener("resize", fixBodyHeight);
fixBodyHeight();
};')
)
)
shinyApp(ui, server)
You can add class and then remove it from server side
(idea of hide head get here )
library(shiny)
library(shinyjs)
library(shinydashboard)
server=shinyServer(
function(input, output,session) {
observeEvent(input$activate,{
js$hidehead('') # show head
removeClass("body_d","DISABLED") # remove class
})
})
ui=
shinyUI(
dashboardPage(
dashboardHeader(disable = T), #title=textOutput("title")),
dashboardSidebar(uiOutput("side")),
dashboardBody(class="DISABLED",id="body_d",
useShinyjs(),
extendShinyjs(text = "shinyjs.hidehead = function(parm){
$('header').css('display', parm);
}"),
tags$style(".DISABLED { min-height: 100vh !important};
"),
actionButton("activate","activate header")
)))
shinyApp(ui,server)
If you dont want to show header after something -- all you need is add class and add css min-height: 100vh !important as example

Adding a company Logo to ShinyDashboard header

So just curious, is there any way to add a company logo to the header of a ShinyDashboard? As I am looking at the documentation, it describes changing the "logo" in the CSS, this is just configuring what goes in the upper left hand corner though as far as I can tell and I would like to keep my title there.
I am not using the drop down menus and so I would like to add my company logo on the top right where the red box is.
Does anyone have any idea how this can be done with Shinydashboard? Thanks.
Update 2020-10-27
For users that are comfortable with HTML or want more flexibility around their user interface and have access to a front end developer, I recently discovered you can use HTML to build the entire user interface. There is a Shiny article about it here. This would allow the entire branding and layout to be done in a way that could comply with your company standards if desired. Hope this helps.
I've been working with a bit of a hack for this, (and I know you didn't ask for it, but here's a clickable logo while we're at it):
library(shiny)
library(shinydashboard)
dbHeader <- dashboardHeader()
dbHeader$children[[2]]$children <- tags$a(href='http://mycompanyishere.com',
tags$img(src='logo.png',height='60',width='200'))
dashboardPage(
dbHeader,
dashboardSidebar(),
dashboardBody()
)
So this nests a shiny.tag inside the header. The second slot in this particular shiny object is the logo slot (You'll need a 'logo.png' in your /www/ folder in the app directory)
EDIT:
I just checked, and as of right now, this hack should no longer be necessary, you can insert the html directly from the dashboardHeader function via the title= parameter, (Before, that parameter was enforcing text only),
I think the answer might still be useful as a method to modify existing shiny functions where things ARE hardcoded in though.
Here's the method now:
dashboardPage(
dashboardHeader(title = tags$a(href='http://mycompanyishere.com',
tags$img(src='logo.png')))
or, adding a little more magic to the logo (I also use my logo as a loading bar):
# Takes a location 'href', an image location 'src', a loading gif 'loadingsrc'
# height, width and alt text, and produces a loading logo that activates while
# Shiny is busy
loadingLogo <- function(href, src, loadingsrc, height = NULL, width = NULL, alt = NULL) {
tagList(
tags$head(
tags$script(
"setInterval(function(){
if ($('html').attr('class')=='shiny-busy') {
$('div.busy').show();
$('div.notbusy').hide();
} else {
$('div.busy').hide();
$('div.notbusy').show();
}
},100)")
),
tags$a(href=href,
div(class = "busy",
img(src=loadingsrc,height = height, width = width, alt = alt)),
div(class = 'notbusy',
img(src = src, height = height, width = width, alt = alt))
)
)
}
dashboardBody(
dashboardHeader(title = loadingLogo('http://mycompanyishere.com',
'logo.png',
'loader.gif'),
dashboardSidebar(),
dashboardBody()
)
Here's my hack (put your logo, as has been mentioned before, into a www subdirectory of your app directory).
Because dashboardHeader() expects a tag element of type li and class dropdown, we can pass such elements instead of dropdownMenus:
library(shiny)
library(shinydashboard)
dbHeader <- dashboardHeader(title = "My Dashboard",
tags$li(a(href = 'http://shinyapps.company.com',
icon("power-off"),
title = "Back to Apps Home"),
class = "dropdown"),
tags$li(a(href = 'http://www.company.com',
img(src = 'company_logo.png',
title = "Company Home", height = "30px"),
style = "padding-top:10px; padding-bottom:10px;"),
class = "dropdown"))
server <- function(input, output) {}
shinyApp(
ui = dashboardPage(
dbHeader,
dashboardSidebar(),
dashboardBody()
),
server = server
)

Resources