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.
Related
First of a small disclaimer: This is my first ever asked question and I am not very experienced with shiny or "R" since this is only for a small project :)
How it is:
I made histograms that show the same data in percentages and quantity.
Currently its looking like this:
The current state of my histograms
What I am trying to do now:
Instead of having 2 histograms vertically I want an input that lets me choose, if I want the data to be shown in percentages or quantities.
I want to add text next to the histogram to describe the data
I want them to align horizontally like this: INPUT - HISTOGRAM - TEXT
How my code is looking up to this point:
ui <- fluidPage(
theme = bs_theme(version = 4, bootswatch = "minty"),
titlePanel("Titanic"),
sidebarLayout(
sidebarPanel(),
mainPanel(
img(src = "titanicPic.jpg",height = 182, width = 520))),
p(""),
h4("", style = "font-family: 'times';,font-si16pt"),
h6("", style = "font-family: 'times';,font-si16pt"),
h6("", style = "font-family: 'times';,font-si16pt"),
tabsetPanel(
tabPanel("x", tableOutput("")),
tabPanel("y", verbatimTextOutput("")),
tabPanel("z", tableOutput(""))),
plotOutput(outputId = "ex1", width = 400),
plotOutput(outputId = "ex2", width = 400)
server <- function(input, output) {
output$ex1 <- renderPlot({
ggplot( survivalMutate,
aes(x = Sex, fill = Status)) +
ggtitle("Wer hat überlebt in %?")+
geom_bar(position = "fill")+
scale_fill_manual(values = c("grey24", "snow")) +
labs(y= "Proportion")
})
output$ex2 <- renderPlot({
ggplot(survivalMutate,
aes(x = Sex,
fill = Status)) +
geom_bar(position = "stack") +
ggtitle("Wer hat überlebt in anzahl?")+
scale_fill_manual(values = c("grey24", "snow"))+
labs(y= "Anzahl")
})
shinyApp(ui = ui, server = server)
In ui you can see in the last two rows that im making the plotOutputs for the two histograms, that I created in the server-part. These take the same data but differ in how they show it (Percentages vs. quantities).
I'd be super thankful for any advice, links to look it up, tips and more.
Thank you a lot If you've read to this point and have a nice day/evening/night!
Welcome! I hope your journey with Shiny and R continues to go well. You have three questions, selecting which plot, adding text next to the histogram, and aligning horizontally. There are plenty of ways to do each of these.
The way I chose to select which plot is using conditionalPanel() and selectInput(). conditionalPanel() checks the selectInput(), and will display only a different graph depending on the choice. An alternative would be using the shinyjs package, and the hide() and show() functions. Here is a link to conditionalpanels: https://shiny.rstudio.com/reference/shiny/1.6.0/conditionalPanel.html And here is some info on the shinyjs package: https://cran.r-project.org/web/packages/shinyjs/vignettes/shinyjs-example.html
For placing text next next to the histogram, and then aligning things horizontally, I used column(). Each row has a width of 12 from my understanding, and so you can select how much room each column takes within that row, so in this case I made put the selectInput() in column(width = 2), since it doesn't need much space, then I put the plots and the extra text in the remaining 10, using column(width = 10). Within a column, that space can also be occupied by a width of 12. In each conditionalPanel(), I made the plot itself a width of 4, and the text a width of 8. Here is a link to some info on columns: https://shiny.rstudio.com/reference/shiny/0.14/column.html
Note that I blocked out a number of features in your code because they weren't necessary to answer the questions, and I just used the built in mtcars data since I don't have your dataset. Here is the code I used.
library(shiny)
library(ggplot2)
ui <- fluidPage(
# theme = bs_theme(version = 4, bootswatch = "minty"), #Not needed for the question
titlePanel("Titanic"),
sidebarLayout(
sidebarPanel(),
mainPanel(
# img(src = "titanicPic.jpg",height = 182, width = 520) #Not needed for the question
)
),
# p(""), #Not needed for the question
# h4("", style = "font-family: 'times';,font-si16pt"),
# h6("", style = "font-family: 'times';,font-si16pt"),
# h6("", style = "font-family: 'times';,font-si16pt"),
# tabsetPanel(
# tabPanel("x", tableOutput("")),
# tabPanel("y", verbatimTextOutput("")),
# tabPanel("z", tableOutput(""))),
column(width = 2,
selectInput("PlotChoose", "Plot by proportion or Anzahl?", choices = c("Proportion", "Anzahl"))),
column(width = 10,
conditionalPanel("input.PlotChoose == 'Proportion'",
column(width = 4,
plotOutput(outputId = "ex1", width = 400)),
column(width = 8,
h4("This is some text that to describe about this proportion plot")
)
),
conditionalPanel("input.PlotChoose == 'Anzahl'",
column(width = 4,
plotOutput(outputId = "ex2", width = 400)),
column(width = 8,
h4("This is some text that to describe about this Anzahl plot")
)
)
)
)
server <- function(input, output) {
output$ex1 <- renderPlot({
ggplot( mtcars,
aes(x = factor(gear), fill = factor(cyl))) +
ggtitle("Wer hat überlebt in %?")+
geom_bar(position = "fill")+
scale_fill_manual(values = c("grey24", "snow", "pink")) +
labs(y= "Proportion")
})
output$ex2 <- renderPlot({
ggplot(mtcars,
aes(x = factor(gear),
fill = factor(cyl))) +
geom_bar(position = "stack") +
ggtitle("Wer hat überlebt in anzahl?")+
scale_fill_manual(values = c("grey24", "snow", "pink"))+
labs(y= "Anzahl")
})
}
shinyApp(ui = ui, server = server)
I hope this gives you ideas on how to move forward, and I wish you the best of luck in your future endeavors!
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.
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.
Aim: divide the available tabPanel into equal cells and display images in cells with Shiny, the number of cells in horizontal space (columns) can be inputted and changed by selectInput. As the number of columns changes, so does the sizes of grids and images.
Problem: how to change the (horizontal and vertical) spacing between cells? how to resize images to fit cells? how to load and display hundreds of images more efficiently with Shiny? Thank you in advance!
Below is the code adapted from this and this, which can display images, but has some problems mentioned before.
rm(list = ls())
library(shiny)
img_dirs <- list.files("www/image", full.names = TRUE)
# img_dirs <- img_dirs[1:10]
img_num <- length(img_dirs)
render_image <- function(img_num, input, output) {
for (i in seq.int(img_num)) {
local({
ii <- i
output[[paste0("img_", ii)]] <- renderImage({
list(src = img_dirs[ii],
contentType = 'image/jpg',
width = '50%',
height = 'auto',
alt = "Image failed to render")
}, deleteFile = FALSE)
})
}
}
ui <- shinyUI(
navbarPage(
theme = shinythemes::shinytheme("cerulean"),
title = "UU",
tabPanel('images',
sidebarPanel(
selectInput('col_num', 'Columns', c(1, 2, 3, 4, 6, 12), selected = 4)),
mainPanel(
uiOutput('myplots'))
)
)
)
server <- shinyServer(function(input, output) {
output$myplots <- renderUI({
## Construct imageOutputs
img_out_lst <- lapply(seq.int(img_num), function(i)
imageOutput(paste0('img_', i)))
fluidRow(
lapply(
split(img_out_lst, f = rep(c(1 : as.numeric(input$col_num)), length.out = length(img_out_lst))),
function(x) column(width = 12 / as.numeric(input$col_num), x, offset = 0, align="center",
style = "padding: 0px 0px; margin-top:-2em")) # fail to decrease spacing
)
})
observeEvent(img_num, render_image(img_num, input, output))
})
shinyApp(ui, server)
I am trying to create an rBokeh plot as an output in my Shiny app with rbokehOutput('plot') in the ui and
output$plot <- renderRbokeh({
figure() %>%
ly_hexbin(x,y)
})
in the server part. I'd like the size of the plot to be dynamic in a sense that it should dynamically resize to fill the entire plot window. I've been playing with the height and width arguments, both in the ui and server parts, but have not been able to make it work; I also tried using sizing_mode = "stretch_both" in the server part. When I display the plot in RStudio without Shiny, the plot does not fill the entire plot window either, it keeps its square shape and aspect ratio. I would like it to behave like a normal R plot, i.e. when I enlarge the plot window, the plot automatically resizes to fill the full window. I found this link, but it only deals with Python implementation. Ideally, I would like the height in Shiny to be fixed at 500px and the width to change dynamically based on the (size of) browser.
Minimal working example:
library(shiny)
library(rbokeh)
ui <- fluidPage(
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
sliderInput('numpoint', 'Number of points to plot', min = 10, max = 1000, value = 200)
),
mainPanel(
rbokehOutput('plot', width = "98%", height = "500px")
)
)
)
server <- function(input, output) {
output$plot <- renderRbokeh({
x <- seq(1, 100, length = input$numpoint)
y <- rnorm(input$numpoint, sd = 5)
figure() %>%
ly_hexbin(x,y)
})
}
shinyApp(ui, server)
Updated MWE:
library(shiny)
library(rbokeh)
ui <- fluidPage(
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
sliderInput('numpoint', 'Number of points to plot', min = 10, max = 1000, value = 200)
),
mainPanel(
fluidRow(
column(12,
rbokehOutput('plot', height = "800px")
)
),
fluidRow(
column(12,
plotOutput('plot1', height = "800px")
)
)
)
)
)
server <- function(input, output) {
output$plot <- renderRbokeh({
x <- seq(1, 100, length = input$numpoint)
y <- rnorm(input$numpoint, sd = 5)
figure(width = 1800, height = 800) %>%
ly_hexbin(x,y)
})
output$plot1 <- renderPlot({
x <- seq(1, 100, length = input$numpoint)
y <- rnorm(input$numpoint, sd = 5)
plot(x,y)
})
}
shinyApp(ui, server)
Updating my answer..
I've added width and height into my call to figure() and the plot now re-sizes responsively.
library(shiny)
library(rbokeh)
ui <- fluidPage(
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
sliderInput('numpoint', 'Number of points to plot', min = 10, max = 1000, value = 200)
),
mainPanel(
rbokehOutput('plot', width = "100%", height = "800px")
)
)
)
server <- function(input, output) {
output$plot <- renderRbokeh({
x <- seq(1, 100, length = input$numpoint)
y <- rnorm(input$numpoint, sd = 5)
figure(width = 1800, height = 800) %>%
ly_hexbin(x,y)
})
}
shinyApp(ui, server)
Is this what you wanted?
Inside of your ui body, you can add the following code:
# This will dynamically set the width of the rBokeh plots
tags$head(tags$script('var dimension = [0, 0];
$(document).on("shiny:connected", function(e) {
dimension[0] = window.innerWidth;
dimension[1] = window.innerHeight;
Shiny.onInputChange("dimension", dimension);
});
$(window).resize(function(e) {
dimension[0] = window.innerWidth;
dimension[1] = window.innerHeight;
Shiny.onInputChange("dimension", dimension);
});
'))
Then you can use the dynamic size as an input oject like
figure(width = input$dimension[1], height = input$dimension[2],