Same height boxes in Shiny dashboard - r

When creating a Shiny dashboard I thought that if the heights of the boxes were equal their tops and bottoms would align. This is not the case. Here the tops are nicely aligned while the bottoms are not:
How do I ensure that the tops and bottoms are aligned?
NOTE: The same misalignment of the bottoms occurs even if the two boxes are filled with the exact same ggplot.
These instructions imply it's quite easy.
It’s possible to force the boxes to all be the same height, by setting height. In contrast to width, which is set using the 12-wide Bootstrap gride, height is specified in pixels.
Sample Code
## app.R ##
library(shiny)
library(shinydashboard)
library(ggplot2)
ui <- dashboardPage(
dashboardHeader(title = "Box alignmnent test"),
dashboardSidebar(),
dashboardBody(
# Put boxes in a row
fluidRow(
box(tableOutput("pop_num"), height = 350),
box(plotOutput("speed_distbn", height = 350))
)
)
)
server <- function(input, output) {
# Population numbers
output$pop_num <- renderTable({
df <- tibble(
x = c(1,2,3,4),
y = c(5, 6, 7, 8)
)
})
# Population distribution graph
output$speed_distbn <- renderPlot({
ggplot(data = cars, aes(x = speed, y = dist)) +
geom_point()
})
}
shinyApp(ui, server)

Note that when you set the heights, the first 350 applies to the box function while the second 350 is passed as an argument to the plotOutput function.
Just make sure both box functions are passed the same height argument; also note that if the plot (including possibly some extra padding/margin) has a total height larger than the enclosing box's height, it will spill out the bottom. So to be safe, pass a height argument to both the plotOutput and box functions:
box_height = "20em"
plot_height = "16em"
ui <- dashboardPage(
dashboardHeader(title = "Box alignmnent test"),
dashboardSidebar(),
dashboardBody(
# Put boxes in a row
fluidRow(
box(tableOutput("pop_num"), height = box_height),
box(plotOutput("speed_distbn",height = plot_height), height = box_height)
)
)
)
Notice that the plot's height is smaller. There's likely a more clever way to automatically do this (and certainly if you do some custom CSS there is!), but for illustration purposes this works.

Related

Reducing space between shiny dashboard elements contained in a box

In the app below, I wrap two plots in a box function to add borders around them to visually distinguish one from the other. However, when doing this, I get an unnecessary amount of whitespace between my input selector and the plots. Can anyone tell me how I can reduce this space. I'm guessing that the solution is using css but I couldn't figure out how to implement it correctly:
Edit: Any potential solutions, just wanted to clarify that the two smaller boxes must exist within the bigger 'Statistics' box.
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(tidyverse)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
fluidRow(
box(title = "Statistics", width = 12, collapsible = T,
sliderInput("numSelect", "Select Value", min = 1, max = 10, value = 5, width = "25%"),
fluidRow(
column(width = 6, box(width = NULL, plotOutput("cars1"))),
column(width = 6, box(width = NULL, plotOutput("cars2"))))
)
)
)
)
server <- function(input, output) {
output$cars1 <- renderPlot(
mtcars %>%
sample_n(input$numSelect) %>%
ggplot(aes(x = mpg, y = hp)) +
geom_point()
)
output$cars2 <- renderPlot(
mtcars %>%
sample_n(input$numSelect) %>%
ggplot(aes(x = mpg, y = hp)) +
geom_point()
)
}
shinyApp(ui, server)
There are many ways to add CSS to your app, but if you only want to affect one single element you can pass the CSS in the argument style that is possible for most of the Shiny functions. In your case you can add the style margin-top to the fluidRow to move the two plots 20 pixels up. The function will looks like this:
fluidRow(style = "margin-top: -20px;",
You can change the value that best fits your needs.

Is there a way to fix the height of tableOutPut or dataTableOutput in shiny?

The app pasted below has a problem; when you hover over some of the data points, the size of the table output increases vertically, pushing the plot down and deselecting the points.
library(tidyverse)
library(shiny)
#example text with short and long entries
example_text <- c("short",
"This text is fairly long and it changes the size of the table: maybe there is a scrolling option?",
"also short",
"Here we have another example of long text ruining everything; I would maybe accept it expanding downwards or sideways",
"not long",
"I'm at a loss for what to do so I'm asking stackoverflow, a website that has helped millions of stuck people")
example_data <- tibble(x = (1:6) ^2, y = sqrt(1:6), hover_text = example_text)
ui <- fluidPage(
fluidRow(
column(10,h1( "hover over the points and the changing size of the table moves the plot and deselects points")),
column(2,tableOutput("dynamic_table"))
),
fluidRow(
plotOutput("plot_out",hover = "plot_hover"),
)
)
server <- function(input, output,session) {
output$plot_out <- renderPlot(ggplot(example_data,aes(x = x, y = y)) + geom_point(size = 5) + labs())
table_out <- reactive(nearPoints(df = example_data,
coordinfo = input$plot_hover,
maxpoints = 1,
threshold = 100))
output$dynamic_table <- renderTable(table_out())
}
shinyApp(ui = ui, server = server)
I forced this behavior here by giving column width 2 to force the table to resize vertically, but in my real use case table itself is quite wide and resizes vertically even with the column width is 12.
So I am looking for something to permanently set the vertical size of the data table regardless of what text is displayed. It could be a tabular output from a different package that uses a scrollbar instead of resizing. It could be an alternative to fluidRow that doesn't dynamically change size. A hacky alternative would be to add a column with a taller element so that will generally be taller than the table, but I haven't tried that/don't know if it would work.
Easiest solution would be to add fix the height of your fluidRow with enough space for the table to be rendered you can do this by adding a style argument to your fluid row and giving enough space
fluidRow(id="tablerow",style="height:400px;",
column(10,h1( "hover over the points and the changing size of the table moves the plot and deselects points")),
column(2,tableOutput("dynamic_table"))
)
Another solution would be to add an overflow to the tableOutput css and fix the height of your fluidRow if you wish to keep the height of your fluid row narrow, in this example I use 200px
example code:
library(tidyverse)
library(shiny)
#example text with short and long entries
example_text <- c("short",
"This text is fairly long and it changes the size of the table: maybe there is a scrolling option?",
"also short",
"Here we have another example of long text ruining everything; I would maybe accept it expanding downwards or sideways",
"not long",
"I'm at a loss for what to do so I'm asking stackoverflow, a website that has helped millions of stuck people")
example_data <- tibble(x = (1:6) ^2, y = sqrt(1:6), hover_text = example_text)
ui <- fluidPage(
tags$head(
# Note the wrapping of the string in HTML()
tags$style(HTML("
#dynamic_table{
overflow-y:auto;
height:200px;
}
"))
),
fluidRow(id="tablerow",style="height:200px;",
column(10,h1( "hover over the points and the changing size of the table moves the plot and deselects points")),
column(2,tableOutput("dynamic_table"))
),
fluidRow(
plotOutput("plot_out",hover = "plot_hover"),
)
)
server <- function(input, output,session) {
output$plot_out <- renderPlot(ggplot(example_data,aes(x = x, y = y)) + geom_point(size = 5) + labs())
table_out <- reactive(nearPoints(df = example_data,
coordinfo = input$plot_hover,
maxpoints = 1,
threshold = 100))
output$dynamic_table <- renderTable(table_out())
}
shinyApp(ui = ui, server = server)

Container settings in text output Shiny

I'm trying to make a render a text output with an automatic scrollbar that is activated when the text becomes too wide or long. For the moment I achieved the scrollbar on the x-axis with container=pre as an argument in the Textoutput in the UI.
What I would want is that the output in the text output limits itself to 4 or 5 rows and then to have a scrollbar in order to see the remaining rows.
I looked at all the posts that I could find for the topic (that's why I implemented the container=pre) but I couldn't find a way to solve the y-axis scrollbar. I understand that it has something to do with overflow y: "auto" in the tags' settings but I can't make it work out, maybe I'm placing it wrong.
Thank you.
Here's an example:
# Shiny example
library(shinydashboard)
library(shiny)
library(stringi)
library(shinyWidgets)
# Data
# Some random letters
names<- stringi::stri_rand_strings(100,20)
# Some random numbers
numbers<- runif(100,0,100000)
# a df
df<- as.data.frame(cbind(names, numbers))
shinyApp(
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
absolutePanel(id="panel", fixed = FALSE,
draggable = F, top = 80, left = "auto", right = 60, bottom = "auto",
width = 290, height = 370,
box( title = "Box example",
status = "warning", width = 230, solidHeader = T,
pickerInput(
inputId = "select_nb_names",
choices = names,
multiple = TRUE,
selected = NULL,
width = 190,inline = FALSE),
# the textoutput that only has an x-axis scrollbar
textOutput("TextThatIWantToHaveAScroll",container = pre ))))),
server <- function(input, output, session) {
output$TextThatIWantToHaveAScroll<- renderText(
paste0( input$select_nb_names," : ",df$numbers[df$names%in%input$select_nb_names],"\n"))
}
# Run the application
)
You can add a scrolls using CSS. In shiny, use the tags$style tag to define the css properties and wrap in a tags$head tag. You can either target element using the ID of the output element (i.e.,#TextThatIWantToHaveAScroll), the shiny class for text outputs (i.e., shiny-text-output), or the tag name (i.e., pre). If you have more than one element that should receive the same treatment, then using .shiny-text-output is a better option.
To create a scroll for the desired element (as in the example; using ID), set the height and width properties first, and then use the overflow: scroll. For example:
#TextThatIWantToHaveAScroll {
width: 100%;
height: 60px;
overflow: scroll;
}
Adjust the height and width as needed. There are other scroll options available. See Mozilla's CSS guide on the overflow property. Here's the full example:
# Shiny example
library(shinydashboard)
library(shiny)
library(stringi)
library(shinyWidgets)
# Data
# Some random letters
names<- stringi::stri_rand_strings(100,20)
# Some random numbers
numbers<- runif(100,0,100000)
# a df
df<- as.data.frame(cbind(names, numbers))
shinyApp(
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
tags$head(
tags$style(
"#TextThatIWantToHaveAScroll {
width: 100%;
height: 60px;
overflow: scroll;
}"
),
),
absolutePanel(id="panel", fixed = FALSE,
draggable = F, top = 80, left = "auto", right = 60, bottom = "auto",
width = 290, height = 370,
box( title = "Box example",
status = "warning", width = 230, solidHeader = T,
pickerInput(
inputId = "select_nb_names",
choices = names,
multiple = TRUE,
selected = NULL,
width = 190,inline = FALSE),
# the textoutput that only has an x-axis scrollbar
textOutput("TextThatIWantToHaveAScroll",container = pre))))),
server <- function(input, output, session) {
output$TextThatIWantToHaveAScroll<- renderText(
paste0( input$select_nb_names," : ",df$numbers[df$names%in%input$select_nb_names],"\n"))
}
# Run the application
)

shiny renderPlot with dynamic height

Problem
I want to change the height of a rendered plot dynamically, so that if it contains a lot of data points more space is allocated to the plot. Content below the plot should then simply be moved.
The height argument of renderPlot can be used for that, but then the plot overflows into the next element and I want to avoid that.
I can circumvent that by using uiOutput, but I was wondering whether I can get the same behaviour without falling back on renderUI?
Expected Outcome
I would like the div below my plot to be moved when the plot sizes changes, without using renderUI
Screenshots
Div does not move
Overflow into div
Code
library(shiny)
library(ggplot2)
ui <- fluidPage(
fluidRow(
column(width = 2, sliderInput("n", "Number of Rows:", 1, 49, 10)),
column(width = 10, plotOutput("plot"))
),
fluidRow( ## the plot oevrflows into this div when the plot grows
column(width = 12, div(style = "background:red; height: 100px"))
),
fluidRow(
column(width = 10, offset = 2, uiOutput("ui"))
),
fluidRow( ## this div is properly moved down as the plot grows
column(width = 12, div(style = "background:red; height: 100px"))
)
)
server <- function(input, output, session) {
data <- reactive(data.frame(id = factor(1:input$n, 1:input$n),
y = rpois(input$n, 200)))
output$plot <- renderPlot(
qplot(id, y, geom = "col", fill = y, data = data()) +
coord_flip(), height = function() 20 * NROW(data())
)
output$ui <- renderUI(plotOutput("plot2", height = 20 * NROW(data())))
output$plot2 <- renderPlot(
qplot(id, y, geom = "col", fill = y, data = data()) +
coord_flip()
)
}
You can write plotOutput("plot", height = "auto") in the ui part. The default height of plotOutput are fixed 400 pixels. By setting height="auto" the plot automatically adjusts to the content.

Shiny large plots overlap

I'm producing some pretty big plots (a grid of about 100 bar graphs). I use verticallayout with the default of fluid = TRUE. I have the size set in my server function
output$hist7 <- renderPlot({ #actual plot excluded though any will do
}, height=1000, width=800)
When I try to place text below this plot with h1("text here"),
"text here" ends up in the middle of hist7. This issue does not occur with any of the plots I didn't set the size for, this is the only one large enough that I have to set a size to prevent shiny scaling it down
The fix should be
ui.R
plotOutput(outputId = 'plot2', width = "700px", height = "600px")
server.R
output$plot2 <- renderPlot({
p <- ggplot(...) + geom_bar(stat="identity", ...)
p
}, width = 700, height = 600)
I had success using inline=TRUE argument in plotOutput and then adding a br() between the plot and my text. E.g.,
column(
plotOutput("my.plot", inline = TRUE),
br(),
h1("my text here")
)
The trick is specifying the same plot size in the ui: plotOutput("hist6", height=1000, width=800)

Resources