Adding a company Logo to ShinyDashboard header
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 dropdownMenu
s:
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
)