Adding a company Logo to ShinyDashboard header - r

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
)

Related

Weird behavior of selectizeInput

In the Shiny App below, I am facing a very strange behavior, where selectInput box slides downwards when I type something in this box. Also, the text inside selectInput box moves towards the right while I type in this box. I have spent a lot of time to find out the reason for this problem but could not figure it out. Can someone point out the mistake I am doing causing this strange behavior?
library(shiny)
library(shinydashboard)
library(highcharter)
siderbar <- dashboardSidebar(
sidebarMenu(
selectizeInput(inputId = "select_by", label = "Select by:", choices = NULL, multiple = FALSE, options = NULL)
)
)
body <- dashboardBody(
fluidRow(
tabBox(
side = "right",
selected = "Tab1",
tabPanel("Tab1", "Tab content 1", highchartOutput("tabset1Selected"))
)
),
)
shinyApp(
ui = dashboardPage(
dashboardHeader(title = "tabBoxes"),
siderbar,
body
),
server = function(input, output, session) {
selectedVal <- reactiveValues()
updateSelectizeInput(session, "select_by", choices = c(as.character(1:10000)), selected = 2, server = TRUE)
output$tabset1Selected <- renderHighchart({
selectedVal <- input$select_by
print(highcharts_demo())
})
}
)
We were on the right track. It has something to do with selectize.js updating the items from the server. You can verify that by setting the loadThrottle option to 5000. This option determines how long the widget waits "before requesting options from the server" (see the manual). Now you have to wait exactly 5 seconds and then the select widget flickers.
The issue seems to be caused by a CSS conflict. selectize.js adds a CSS class to the widget. If you remove that feature, the flicker goes away.
selectizeInput(inputId = "select_by", label = "Select by:",
choices = NULL, multiple = FALSE,
options = list(loadThrottle=200, loadingClass=""))
loadingClass sets a specific CSS class (default: 'loading') while loading data from the server. Purpose: to change how the widget looks and communicate to users that an update is in progress.
loadThrottle does not need to be set. It's default is 300. You can set it to any value that suits your needs.
Details
highcharter defines it's own CSS class names loading with these specs:
.loading {
margin-top: 10em;
text-align: center;
color: gray;
}
That is the reason for the CSS conflict. The widget gets a top margin and it's content moved to the center, because the browser does not distinguish the source of the class. It only sees some CSS that fits and uses it. This image shows where you need to look:

R Shiny - dropdownMenu code in server - styling goes bonkers

For the dropdownMenu in the header, I want to change the icon reactively, so I have to place the code into server. However the styling goes bonkers, is there a way to keep the original styling? I've tried manually copying styles and setting everything important but it still doesn't work.
In this example, there are two dropdownMenu blocks, one in the ui (looks good) and one in the server (looks bad). I want to make the bad one look the same as the good one.
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
shinyApp(
ui = dashboardPagePlus(
header = dashboardHeaderPlus(
uiOutput("my_dropdown"),
dropdownMenu(
type = "tasks",
badgeStatus = "danger",
icon = "Looks good"
)
),
sidebar = dashboardSidebar(),
body = dashboardBody(),
rightsidebar = rightSidebar()
),
server = function(input, output) {
output$my_dropdown <- renderUI({
dropdownMenu(
type = "tasks",
badgeStatus = "danger",
icon = "Looks bad"
)
})
}
)
This is what it looks like
This is what it should look like

Adding images in the title and at the right of navbarPage

I would like to include a small image at the left of the title of my navbarPage, and to include another image completely at the right of this same navbarPage. I found this answer which provides the same layout than the one I would like to have. The problem is that this solution does not provide a fully reproducible example and I can't figure out how to include the chunks of code in the ui part.
Does anybody know how to make a reproducible example from this answer?
Here's what I've tried so far:
library(shiny)
ui <- navbarPage(
tags$script(HTML("var header = $('.navbar > .container-fluid');
header.append('<div style=\"float:right\"><h3>This is R</h3></div>');"
)),
tags$script(HTML("var header = $('.navbar > .container-fluid');
header.append('<div style=\"float:right\"><img src=\"image.png\" alt=\"alt\" style=\"float:right;width:33px;height:41px;padding-top:10px;\"> `</div>');
console.log(header)")
),
title = div(img(src="image.png", height = '40px', width = '40px'), "something"),
tabPanel("foo")
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
This is the image called image.png. I put it in the www folder, which is placed in my app directory.
There are mainly two things to solve:
* some text is displayed on the below the navbar whereas it shouldn't be displayed at all
* the image and the text at the left are not centered
I did not make any change to your code (well except the tags$head() at the begining, but that's an add on).
The only problem with your code is not the problem in your code, is the problem in your files structure.You have to place your images inside a new folder called www (Note that the folder www is in the same place as your R code which is app.R or ui.R).
library(shiny)
ui <- fluidPage(
tags$head(
tags$link(rel = "shortcut icon", type = "image/png", href = "image.png"),
tags$title("Browser tab title")
),
navbarPage(
tags$script(HTML("var header = $('.navbar > .container-fluid');
header.append('<div style=\"float:right\"><h3>This is R</h3></div>');"
)),
tags$script(HTML("var header = $('.navbar > .container-fluid');
header.append('<div style=\"float:right\"><img src=\"image.png\" alt=\"alt\" style=\"float:right;width:33px;height:41px;padding-top:10px;\"> </div>');
console.log(header)")
),
title = tags$div(img(src="image.png", height = '40px', width = '40px'), "something"),
tabPanel("foo")
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
Note: I've added the navbarPage inside a fluidPage because without the fluidPage, the title of the NavBarPage will be the title in the browser tab!But now the main UI is the fluidPage so it's title will be the browser title. this also gives you flexiblity to add a new image for the browser tab, different from the navbar page's tab.
Here's the screen shot of the output.
Hope this helps!

Configure Shiny app to display mathjax text out as HTML Preview by default

I'm Building a dashboard using the packages shiny and shinydashboard, The issue I am having is when I try to include a math symbol inline with text when the app is launched it always smaller than its surrounding text. When the app is launched and right click on a math symbol and navigate to
Math Setting>Math Render> the switch from HTML-CSS to HTML Preview it becomes the correct size. Wondering why this is the case and how I can make appear as the correct size by default so I don't have users switch HTML preview when they launch the app.
I tried adding the follow to change my Mathjax configuration upon the apps launch but it didn't seem to have any effect:
tags$div(HTML("<script type='text/x-mathjax-config' >
MathJax.Hub.Config({
showProcessingMessages: true,
jax: ['input/TeX', 'output/PreviewHTML'],
});
</script >
"))
Here is a basic version of what I'm dealing with when ran the Mu symbol is much smaller than the other text.
header <- dashboardHeader(
#Set the title and title size of the dashboard. This will be located in top left coner of app.
title = "My Dashboard",
titleWidth = 400
)
# Sidebar Layout
# Contains the design for collapsable sidebar of the dashboard which allows users to navigate to its differnt pages.
sidebar <- dashboardSidebar(
sidebarMenu(
# Each item navigates the dashboard to its corresponding page
menuItem("Inputs", tabName = "inputs",icon = icon("angle-right"))
)
)
#Boday Layout
# Contains the design for each indivual page listed within the side bar
body <- dashboardBody(
withMathJax(),
tags$div(HTML("<script type='text/x-mathjax-config' >
MathJax.Hub.Config({
showProcessingMessages: true,
jax: ['input/TeX', 'output/PreviewHTML'],
});
</script >
")),
dashboardBody(
# TabItemS refrences theset of dashboard pages as whole
tabItems(
# First Pages contents
tabItem(
tabName = "inputs",
h1("Here is the Problem"),
fluidRow(
box(width = 4,
h3("This symobl \\(\\mu\\) is much smaller")
)
)
)
)
)
)
ui <- dashboardPage(header,sidebar,body)
server <- function(input, output) {
}
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).

Resources