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
Related
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 have the following code that makes a simple shiny app.
```
library(shinydashboard)
library(shiny)
ui <- dashboardPage(
dashboardHeader(title = tags$img(src='https://cdn.vox-cdn.com/thumbor/Ous3VQj1sn4tvb3H13rIu8eGoZs=/0x0:2012x1341/1400x788/filters:focal(0x0:2012x1341):format(jpeg)/cdn.vox-cdn.com/uploads/chorus_image/image/47070706/google2.0.0.jpg', height = '60', width ='100')),
dashboardSidebar(
sidebarMenuOutput("menu")
),
dashboardBody()
)
server <- function(input, output) {
output$menu <- renderMenu({
sidebarMenu(
menuItem("Overview", icon = icon("tachometer"))
)
})
}
shinyApp(ui, server)
```
And the image is outputted on top of the menu to the right, but my goal would be to have the image be more in the middle of the dashboard. I know the menu shifts the navabr a bit but I would like to keep it as center as possible.
But my desired output would be like this. I made a sample with paint. Is it possible to still have some text or if a reference can be posted where I can learn more about the dashboard header function I would appreciate it.
Here you go
There is no way you can add the image to the header part on the right side with the function from shinydashboard, but let's have fun with the latest htmltools by injecting styles and tags into the header.
library(shinydashboard)
library(shiny)
header_img <- tags$img(
src='https://cdn.vox-cdn.com/thumbor/Ous3VQj1sn4tvb3H13rIu8eGoZs=/0x0:2012x1341/1400x788/filters:focal(0x0:2012x1341):format(jpeg)/cdn.vox-cdn.com/uploads/chorus_image/image/47070706/google2.0.0.jpg',
style = 'height: 50px; width: 100px; position: absolute; left: 50%; transform: translateX(-50%);'
)
header <- htmltools::tagQuery(dashboardHeader(title = ""))
header <- header$
addAttrs(style = "position: relative")$ # add some styles to the header
find(".navbar.navbar-static-top")$ # find the header right side
append(header_img)$ # inject our img
allTags()
ui <- dashboardPage(
header,
dashboardSidebar(
sidebarMenuOutput("menu")
),
dashboardBody()
)
server <- function(input, output) {
output$menu <- renderMenu({
sidebarMenu(
menuItem("Overview", icon = icon("tachometer"))
)
})
}
shinyApp(ui, server)
The img is placed on the center of right side header, not the center of the entire header length. If you want to adjust to the center of the whole length, try to change translateX(-50%) of the img to a number you like.
The Shinyglide package is just what I need, using a carousel for grouped radio buttons giving the user many choices for data parsing.
However, the "Next" (and "Back") button occupies a large white space. I'd like to shift the button in line with the glide row (see image at bottom). Does anyone know how to do this? Is there a CSS trick? Reading through the Glide manual, the only choices are "top" and "bottom".
If moving the Next/Back button isn't possible, a secondary option is to insert (a somewhat superfluous) line of text but in line with the Next/Back buttons, to at least cover up the annoyingly large white space.
The actual panel this is for has much more information presented than in this example, so I'm trying to make the page as clean as possible.
Please see image at bottom that better explains what I'm trying to do.
Reproducible example:
library(dplyr)
library(DT)
library(shiny)
library(shinyglide)
ui <-
fluidPage(
fluidRow(div(style = "margin-top:15px"),
strong("Input choices shown in row below, click ´Next´ to see more choices:"),
column(12, glide(
height = "25",
controls_position = "top",
screen(
div(style = "margin-top:10px"),
wellPanel(
radioButtons(inputId = 'group1',
label = NULL,
choiceNames = c('By period','By MOA'),
choiceValues = c('Period','MOA'),
selected = 'Period',
inline = TRUE
),
style = "padding-top: 12px; padding-bottom: 0px;"
)
),
screen(
div(style = "margin-top:10px"),
wellPanel(
radioButtons(inputId = 'group2',
label = NULL,
choiceNames = c('Exclude CT','Include CT'),
choiceValues = c('Exclude','Include'),
selected = 'Exclude',
inline = TRUE
),
style = "padding-top: 12px; padding-bottom: 0px;"
)
)
)
)
),
DTOutput("plants")
)
server <- function(input, output, session) {
output$plants <- renderDT({iris %>% datatable(rownames = FALSE)})
}
shinyApp(ui, server)
You could use a custom control element with custom_controls, and then have it hover over the displayed screen on the top right with a container set to absolute positioning. Setting a limited width for the container will ensure that the back button won't fly too far out.
Something along these lines:
glide(custom_controls = div(class = "glide-controls", glideControls()), ...)
# Somewhere in the UI
tags$style(
".glide-controls { position: absolute; top: 18px; right: 15px; width: 160px; }"
)
Just make sure to also set controls_position = "bottom" so that the controls hover over the screen content, rather than under it.
A minimal example app:
library(shiny)
library(shinyglide)
ui <- fixedPage(
h3("Simple shinyglide app"),
tags$style(
".glide-controls { position: absolute; top: 18px; right: 15px; width: 160px; }"
),
glide(
custom_controls = div(class = "glide-controls", glideControls()),
screen(wellPanel(p("First screen."))),
screen(wellPanel(p("Second screen.")))
)
)
server <- function(input, output, session) {}
shinyApp(ui, server)
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.
I want to have scroll bar to scroll up and down, cross button to close the pop up window and default of 10 records should display instead of 25 now.
I don't know how to write code for this.
library(shiny)
library(shinydashboard)
library(shinyjs)
library(shinyBS)
data <- iris
ui <- tagList(
useShinyjs(),
dashboardPage(
dashboardHeader(title = "Telemedicine HP"),
dashboardSidebar(),
dashboardBody(
fluidRow(
div(id='clickdiv',
valueBox(60, subtitle = tags$p("Attended", style = "font-
size: 200%;"), icon = icon("trademark"), color = "purple", width = 4,
href
= NULL)
)
)
)
)
)
server <- function(input, output, session){
onclick('clickdiv', showModal(modalDialog(
title = "Your title",
renderDataTable(data)
)))
}
shinyApp(ui, server)
By clicking on valuebox a pop up window will appear showing some tabular data.
But that window should have a scroll bar, cross button in right top corner and records should be shown 10 by default instead of 25 showing now in top left corner of the pop up window.
Can anyone help me with this ?
If your server part is like this, it is limited to 10 shown per page:
server <- function(input, output, session){
onclick('clickdiv', showModal(modalDialog(
title = "Your title",
renderDataTable(data, options = list(
pageLength = 10,
scrollY = "400px"
))
)))
}
I'm not sure I understand the need for the other parts. With 10 records, you don't need to be able to scroll up and down, but even when I set this to a lot of records (say 100), the normal page scroll bar works fine. And there is a button to dismiss the table already (although I appreciate it is not the cross in the corner you are requesting).
You can change other parts of your DataTable using the options - you can see some examples here.
Hope this helps!
EDIT: I've added an option for a vertical scroll bar. You can change the number to suit you.
If that doesn't work then you might be using a setup (for eg Mac) where scrollbars are hidden by default until you start scrolling.