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)
Related
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)
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.
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.
I've made a cool Shiny app that allows users to resize their plot and move it around on the canvas.
The problem is, sometimes the downloaded plot looks very different from what is displayed in the view panel - it comes out as a square graphic that might have the plot cut off if as you change the scale and positioning.
If you draw it at 0.5 scale it looks the same in browser and in the downloaded png. -- But if you make it to scale 0.8, or even simply scale 1.0, it'll look perfect in the view panel but ugly and misaligned when printed with ggsave().
Perhaps this is a question about adjusting parameters to ggsave? Or is it that my background image is sized strangely (1920 x 1028 pixels)? Or perhaps the reactive panel throws it off somehow...? I'm confused at this point.
Anyway I drew a grey background behind the plot area so that you can easy tell the canvas from the panel.
And here is a minimal reproducible example.
library(shiny)
library(tidyverse)
library(magick)
library(cowplot)
picture <- 'https://content.halocdn.com/media/Default/games/halo-5-guardians/map-images/arena/arena_maps_sustain_array04-bddc574f8e3445d08f24ef859fb96941.jpg'
background <- image_read(picture)
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
sliderInput("xposition",
"X-Axis Position",
min = -1,
max = 1,
value = 0,
step = 0.1),
sliderInput("yposition",
"Y-Axis Position",
min = -1,
max = 1,
value = 0,
step = 0.1),
sliderInput("scale",
"Chart Scale",
min = .25,
max = 1,
value = .5,
step = 0.1)),
# Show a plot over grey background to see how canvas shifts
mainPanel(style = "background:grey",
plotOutput("distPlot"),
downloadButton("downloadPlot", "Download")
)
)
)
server <- function(input, output) {
xposition <- reactive({input$xposition})
yposition <- reactive({input$yposition})
scale <- reactive({input$scale})
plot <- reactive({
base_plot <- ggplot(faithful, aes(x = waiting), bins = input$bin) +
geom_histogram()
ggdraw() +
draw_image(background) +
draw_plot(base_plot, x = xposition(), y = yposition(), scale = scale())
})
## Use Cowplot package to alter scale and position
output$distPlot <- renderPlot({
# draw the histogram with the specified number of bins
plot()
})
output$downloadPlot <- downloadHandler(
filename = "my_awesome_plot.png",
content = function(file) {
ggsave(file, plot())
}
)
}
# Run the application
shinyApp(ui = ui, server = server)
If you try scale 0.5, scale 0.8, and scale 1.0, you'll see what I mean!
Any help????
Note: The reproducible example above should be enough to find the problem, but if you want to see a more "in depth" example here is my real app which has more images in it and more reactive scalings and positionings.
https://jjohn987.shinyapps.io/Halo5_Stats/
Type in a player's tag name (e.g., these work => hi, k, hairball9000, or other gamer tags people use, but no commas or spaces) and you'll see that what appears to be "the bottom" of the plot is very different than what the bottom is in the download... Keep in mind I haven't applied for any significant api bandwidth from Microsoft so the calls might get timed out depending on how many people try to help!
My goal is to divide the page in four quadrant, each with a separate set of plots.
I have one quadrant ready. It looks ok when it occupies the entire window. I would like to have 4 such panes on a single page. As you can see from the screenshot (of the two upper quadrants), inserting the pane that is already ready in the upper left quadrant results in something very blurry. How can I have the graphs not become blurry?
I used fluidrow, perhaps is this not a good idea?
ui = fluidPage(
fluidRow(
column(6,
fluidRow(
column(8, plotOutput("barChart1", height = 250))
, column(4, plotOutput("compteur1", height = 250))
)
,fluidRow(
column(3,
dateRangeInput(
"dateRange2",
label = "Choose the window:",
start = "2016-09-01"
)
)
, column(3,
selectInput("security", "Index:", selected = worldindices[1]
, list(`World Indices` = worldindices,
`Regional Indices` = regionIndices,
`Country Indices` = countryIndices)
)
)
, column(3,
selectInput("metric", "Metric:", selected = plainMetrics[1]
, list(plainMetrics
, `Valuation Multiples` = valMul
, `Fundamentals` = corpFund)
)
)
)
, plotOutput("chartAggr", height = 250)
)
, column(6, style = "background-color:yellow;", div(style = "height:500px;")
)
)
)
Kind regards
EDIT - FOLLOWING ANSWER BELOW:
Trying to give a higher value to the res parameter of renderPlot on the server side does not seem to work. I gave it for instance the value 128, and get the following result:
In your renderPlot() function on the server pass in the res argument... set it to something higher than the default 72 pixels/inch.
renderPlot(expr, width = "auto", height = "auto", res = 72, ..., env
= parent.frame(), quoted = FALSE, execOnResize = FALSE, outputArgs = list())
Note you may need to adjust the size of your plot and add scrollbars to your containers to accommodate the larger high resolution image.
## Something like this on the server
output$barChart1 <- renderPlot(PLOT(), width = 1000, height = 1000, res = 128)
## Something like this on UI
div(style = 'overflow-x: scroll',
plotOutput("barChart1", inline = TRUE))
)
I know this is an old post, but I thought I'd share my solution to the problem.
I was scaling the height of my plot proportionately to the plot's width in order to fix the aspect ratio using the following renderPlot code:
observeEvent({
input$timelinecontinentselector
input$timelinearrangeselector
input$timelinesmoothselector == TRUE
}, {
output$timeline_plot <- renderPlot({
timeline_plotting()
}, height = function() {
round(session$clientData$output_timeline_plot_width * 0.4)
})
})
Crucially, without the round() function initially. I can only assume that the expression produced a height value with decimals which caused the renderer to struggle. The issue disappeared once the value was rounded to a whole number.