This SO post describes how to add an actionButton to the top right of the dashboardHeader in a shinydashboard. I would like to add two action buttons next to each other in the dashboardHeader. How can I place the buttons within the header bar so that they do not overlap? More specifically, is there a way to move a button to the left and centre it vertically within the dashboardHeader?
Perhaps you are looking for this
ui <- dashboardPage(
dashboardHeader(title = div("Testing Work Space",
img(src = 'YBS.png',
title = "Just a Test Application", height = "30px"),
style = "position: relative; margin:-3px 0px 0px 5px; display:right-align;"
),
titleWidth=350,
tags$li(div(
img(src = 'YBS.png',
title = "A Test Graphics Application", height = "30px"),
style = "padding-top:15px; padding-right:100px;"),
class = "dropdown"),
tags$li(a(href = 'http://www.cnn.com',
icon("power-off"),
title = "CNN Home"),
class = "dropdown"),
tags$li(a(href = 'https://en.wikipedia.org/wiki/Mouse',
tags$img(src = 'mouse.png', height = "30px"),
title = "Mouse Home"),
class = "dropdown")
),
dashboardSidebar(),
dashboardBody()
)
server <- function(input, output,session) {}
shinyApp(ui, server)
You can adjust padding and margin to suit your needs. Also, you can add multiple actionButtons.
I can't answer your question directly because I have only used Flexdashboard. But there is a shinyWidgets package that contains a DropDown widget that allows you to embed multiple widgets into the DropDown. So if the dashboard header only allows a single widget, you could use a dropdown widget to access multiple widgets indirectly See:
http://shinyapps.dreamrs.fr/shinyWidgets/
And the dropdowns & sweetalert menu item. The sample dropdowns there contain links to the underlying shinyWidgets code.
Related
I have the following snippet of code:
shinyUI(fluidPage(
useShinyjs(),
shinyjs::hidden(div(
id = "application",
navbarPage(
title = div(img(src="img_1.png", filetype="image/png"), "Indicators"),
id = "tabs",
tabpanel("Admin", ...)
tabpanel("User", ...)
)
))
))
I would like to add a second image, let's call it img_2.png to the right of the navbar, i.e. at the end of the navbar itself. Maybe the fact that I used title = forces me to place only one image in the navbar. Could anyone help me?
you can add an additional img tag and an style parameter, that sets the position to the right side:
title = div(img(src="img_1.png", filetype="image/png"), "Indicators", img(src="img_1.png", filetype="image/png", style = "position: fixed;right: 20px;"))
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:
I'm trying to put some Datatables and Histograms inside boxes of defined height in a Shiny Dashboard, the problem is that when I fix the height (lets say, to 250), the datatable exceeds the limits.
I know we have "autowidth" to use with datatables, but havent seen nothing similar for the Height. I tried to fix the height of the datatable too, but that didn't work for me neither. Also, when I open the shiny in a smaller screen, the box would resize, but the datatable don't.
Here's an example of the problem
library(shiny)
library(shinydashboard)
library(htmltools)
ui <- dashboardPage(skin = "black", title = "Dashboard",
dashboardHeader(title = "Dashboard"),
dashboardSidebar(width = 300),
dashboardBody(
tags$head(tags$style(HTML("
div.box {
text-align: center;
border-style: solid;
border-bottom-color:red;
border-left-color:red;
border-right-color:red;
border-top-color:red;
border-bottom-width:20px;
border-top-width:20px;
border-left-width:20px;
border-right-width:20px;
}
"))),
box(title = "Resume", width = 4, column(12, withSpinner(DT::dataTableOutput("tab"))),
align="center", status = "danger",solidHeader = T,height=250)
))
server <- function(input, output) {
output$tab <- DT::renderDataTable({
datatable(head(iris),options=list("autoWidth"=TRUE, "pagelength"=15,"scrollY"=TRUE,"scrollX"=TRUE,"searching"=FALSE))
})
}
# Run the application
shinyApp(ui = ui, server = server)
Actually ScrollX works perfectly, why scrollY doesnt work aswell?
I read about using tabBox instead of Box, but that doesnt work neither.
Thank you very much in advance.
Try withSpinner(DT::dataTableOutput("tab", height = '240px'), currently your code is setting the height of the box, not the data table.
Also, try style = "overflow-x: scroll;" in the box() arguments for the scrolling
I am using the shiny dashboard template to generate my web UI.
I'd like to dynamically generate an infobox when a computation is completed with a link directed to one of the tabItems in dashboardBody.
For example,
I can put this in my tabItem1 output,
renderInfoBox({
infoBox("Completed",
a("Computation Completed", href="#tabItem2"),
icon = icon("thumbs-o-up"), color = "green"
)
})
But the problem is that when I click the link, it does nothing. I would like it jumps to tabItem2. The link href seems valid when I hover on it.
Thanks!
Update:
Other than using Javascripts, looks like using actionLink and updateTabItems functions in shinydashboard package will work as well.
I apologize for the lengthy code sample, but I had to copy an example with tabItems from the shinydashboard homepage.
Your approach has only few problems. First, if you would inspect the menuItems, you'd see that the actual tab's id is not tabItem2, but shiny-tab-tabItem2. This, plus the extra attribute data-toggle="tab" within the a tag would suffice to open the desired tab. Snippet:
a("Computation Completed", href="#shiny-tab-tabItem2", "data-toggle" = "tab")
But, this has its limits. First and most obvious, the state of the menuItem in the sidebar is not set to active. This looks very odd and one might not be convinced, that one has been moved to another tab.
Second, and less obvious, if you listen to tab changes (on the server side), you will not get information about this tab switch. Those are triggered by the menuItem being clicked, and the tab itself will not report if it is visible or hidden.
So, my approach will be to simulate that the corresponding menuItem is clicked, and thus, all the above problems are solved.
Code example:
library(shiny)
library(shinydashboard)
ui <- shinyUI(
dashboardPage(
dashboardHeader(title = "Some Header"),
dashboardSidebar(
sidebarMenu(
menuItem("Computations", tabName = "tabItem1", icon = icon("dashboard")),
menuItem("Results", tabName = "tabItem2", icon = icon("th"))
)
),
dashboardBody(
tags$script(HTML("
var openTab = function(tabName){
$('a', $('.sidebar')).each(function() {
if(this.getAttribute('data-value') == tabName) {
this.click()
};
});
}
")),
tabItems(
tabItem(tabName = "tabItem1",
fluidRow(
box(plotOutput("plot1", height = 250)),
box(
title = "Controls",
sliderInput("slider", "Number of observations:", 1, 100, 50)
)
),
infoBoxOutput("out1")
),
tabItem(tabName = "tabItem2",
h2("Widgets tab content")
)
)
)
)
)
server <- function(input, output){
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
output$out1 <- renderInfoBox({
infoBox("Completed",
a("Computation Completed", onclick = "openTab('tabItem2')", href="#"),
icon = icon("thumbs-o-up"), color = "green"
)
})
}
shinyApp(ui, server)
Note, that the only important thing is the onclick property, not an href. This means, that every div or other element can be used to create this link. You could even have just the thumbs-up image with this onclick command.
If you have more questions, please comment.
Best Regards
Edit: Whole infoBox clickable.
This is an answer to a comment by OmaymaS. The point was to make the infoBox a clickable container. To achieve this, one can define a new function that makes a somewhat different infoBox. The custom box will be as follows:
customInfoBox <- function (title, tab = NULL, value = NULL, subtitle = NULL, icon = shiny::icon("bar-chart"), color = "aqua", width = 4, href = NULL, fill = FALSE) {
validateColor(color)
tagAssert(icon, type = "i")
colorClass <- paste0("bg-", color)
boxContent <- div(class = "info-box", class = if (fill) colorClass,
onclick = if(!is.null(tab)) paste0("$('.sidebar a')).filter(function() { return ($(this).attr('data-value') == ", tab, ")}).click()"),
span(class = "info-box-icon", class = if (!fill) colorClass, icon),
div(class = "info-box-content",
span(class = "info-box-text", title),
if (!is.null(value)) span(class = "info-box-number", value),
if (!is.null(subtitle)) p(subtitle)
)
)
if (!is.null(href)) boxContent <- a(href = href, boxContent)
div(class = if (!is.null(width)) paste0("col-sm-", width), boxContent)
}
This code is copied from the original infoBox function definition and only the line with onclick is new. I also added the openTab function (with some twitches) right inside the container such that you dont need to worry where to put this function inside the view. Might be a bit overloaded i feel.
This custom info box can be used exactly like the default one and if you pass the additional tab argument, the link to the sidebar is added.
Edit: Subtitle exploit
As Alex Dometrius mentioned, the use of subtitle crashes this functionality. This is because the script tag that was inserted, on accident, was used as the subtitle argument in order to be rendered with the box. To free up this spot, I edited the main example up top such that the script tag is sitting top level in the dashboardBody (literally anywhere in the ui would be fine).
(To avoid confusion: in Version 1, the tags$script was supplied inside of infobox where it was interpreted as the subtitle parameter.)
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
)