I have a Shiny App which can display graphs based on user input (ie. years selected, type of dataset, etc.)
This is similar to what I have in the original code, reactively takes the user input and the display figure size is controlled by height and width parameters.
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("plotType", "Plot type:",
c("Scatter Plot" = "scatter", "Line Plot" = "line"))
),
mainPanel(
plotOutput("plot")
)
)
)
server <- function(input, output, session) {
output$plot <- renderPlot({
plot(mtcars$mpg, mtcars$wt)}, height = 1000, width = 1000)
}
shinyApp(ui, server)
However, since there's so much data and the graph can take a bit of time to load, I wanted to have a cache method so that once a graph version loaded, it's can be retrieved without reloading. However, "width, height
not used. They are specified via the argument sizePolicy." - https://mpn.metworx.com/packages/shiny/1.6.0/reference/renderCachedPlot.html
But as the two code examples show, sizePolicy does not expand the height as much as the original code. In fact, in the code I have, it shrinks the plot incredibly small. I'm very confused about this and could not find similar questions/answers on the web. Am I using the renderCachedPlot wrong? Am I supposed to combine it with renderPlot? Or does renderCachedPlot is unable to set figure size? If so, what's better way to save on graph loading time?
server <- function(input, output, session) {
output$plot <- renderCachedPlot({
if (input$plotType == "scatter") {
plot(mtcars$mpg, mtcars$wt)
} else if (input$plotType == "line") {
plot(mtcars$wt, type = "l")
}
}, cacheKeyExpr = reactive({
input$plotType
}), sizePolicy = sizeGrowthRatio(width = 1000, height = 1000, growthRate = 1.2))
}
2/1 Update: So I realize that in the within the ui code, I could specify the plotOutput("plot", width = 1000, height = 1000) and see a change. This brings about another issue where in the server code, there are calculations done dependent on the number of graphs selected to give plotwidth and plotheight. How and should I call upon a variable in the server to the UI?
Thanks in advance! Please direct me to any resources I missed.
Related
I have recently written a Shiny app that takes user data input, does some analysis on it, and then displays the results, including graphs. These graphs take a while to render, so I am using withSpinner to inform the users that Shiny is busy and to be patient and wait for the graphs to appear. The graphs are displayed within boxes that have titles informing the users what the graphs show.
What gets displayed to the users depends on the data they provide to the app (how many items of data are provided in their input file) and also which options they choose from within the app (using checkboxes).
The withSpinner function works well for the graphs when wrapped around plotOutput and called from within ui (see line 38 of the example code below).
However, to use this approach for all graphs would require me to know how many items of data the users are likely to provide and then want to view. I would like to just automatically produce a graph, with a spinner, for each data item, without knowing how many there are in advance.
Placing withSpinner within the server doesn’t work at all (lines 58-65), which makes sense. However, if I use it in the ui around the uiOutput object for all of the boxes and graphs (line 29), the spinner only shows until the boxes are rendered – the graphs then appear about a minute later…
Please can you help me to work out how to get the spinners to show until the graphs are rendered? Thank you for any help you can give!
library(shiny)
library(shinydashboard)
library(shinyjs)
library(shinycssloaders)
library(survival)
ui <- dashboardPage(
skin = "blue",
dashboardHeader(title = "My App"),
dashboardSidebar(
sidebarMenu(
useShinyjs(),
id = "tabs",
menuItem("User Choice", tabName = "uChoice", icon = icon("sliders-h"))
)
),
dashboardBody(
id = "dashboardBody",
tabItems(
tabItem(
tabName = "uChoice",
h2("You have a choice"),
# Check boxes to select choice
fluidRow(
uiOutput("userChoiceCheckbox")
),
fluidRow(
# Only show the data graphs that the user has chosen to look at
withSpinner(uiOutput('chosenGraphs'), type=4)
# this spinner only shows until the box containing the graph is rendered
),
fluidRow(
# Always show lung graph
box(
title = paste("Here's the lung graph"),
width = 12,
height="50px",
withSpinner(plotOutput("lungGraph"), type=4)
# This spinner shows until the graph is plotted
)
)
)
)
)
)
server <- function(input, output, session) {
output$userChoiceCheckbox <- renderUI({
column(6, checkboxGroupInput(inputId = "choices", label = "Which graph(s) would you like to view?", choices = c("Lung", "PBC")))
})
output$chosenGraphs <- renderUI({
lapply(input$choices, function(x) {
box(
title = paste("Graph for", x,"cancer"),
width = 12,
renderPlot({
withSpinner(
# This spinner doesn't seem to work at all
plotOutput({
Sys.sleep(2)
plot(survfit(Surv(time, status) ~ 1, data = eval(as.symbol(tolower(x)))),
xlab = "Days",
ylab = "Overall survival probability")
})
)
})
)
})
})
output$lungGraph <- renderPlot(
plot(survfit(Surv(time, status) ~ 1, data = lung),
xlab = "Days",
ylab = "Overall survival probability")
)
}
shinyApp(ui, server)
In case you didn't find an answer, I couldn't add a single spinner per plot but the whole renderUI region can be wrapped by withSpinner() if you add it after the lapply().
In your case it would be something like this:
output$chosenGraphs <- renderUI({
lapply(input$choices, function(x) {
box(
title = paste("Graph for", x,"cancer"),
width = 12,
renderPlot({
plotOutput({
Sys.sleep(2)
plot(survfit(Surv(time, status) ~ 1, data = eval(as.symbol(tolower(x)))),
xlab = "Days",
ylab = "Overall survival probability")
})
})
)
}) %>% withSpinner()
})
The transitions of my Shiny app are very long when I change a numericInput value by clicking on the button "quickly" several times in a row .
How can I stop the previous code from running once a new numericInput has changed ? I don't know if I explained my problem clearly. Is it possible to put a GIF in a StackOverflow post ?
Try to play with the button to understand my problem
# USER INTERFACE
ui <- fluidPage(
sidebarLayout(
sidebarPanel(numericInput("sd", p("sd"), value = 0.1, step = 0.1)),
mainPanel(plotOutput("plot"))
)
)
# SERVER
server <- function(input, output) {
output$plot<- renderPlot({
x <- seq(-1, 1, length.out = 50000)
plot(x, x + rnorm(50000, sd = input$sd), ylab = "y")
})
}
shinyApp(ui = ui, server = server)
You can’t cancel a computation once it’s started without setting up some sort
of subprocess processing. However, even that would not help in this case,
because the time-consuming operation is the actual graphics rendering. You’d
need a custom equivalent to renderPlot() to handle that.
Likely the best you can do here is to debounce() the input, so that you
won’t start plotting until the input value has settled for some amount of time:
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(numericInput("sd", p("sd"), value = 0.1, step = 0.1)),
mainPanel(plotOutput("plot"))
)
)
server <- function(input, output) {
input_sd <- debounce(reactive(input$sd), 400)
output$plot <- renderPlot({
x <- seq(-1, 1, length.out = 50000)
plot(x, x + rnorm(50000, sd = input_sd()), ylab = "y")
})
}
shinyApp(ui = ui, server = server)
Or if changing inputs too quickly is still a problem even when debounced, accept that and use a submit button to explicitly trigger the plotting.
My problem here is, I think, an edge case for this type of problem. With that said, I've got some reproducible code here that might help a lot of people with similar issues they have, particularly the issue of changing a ggplot's plot height in RShiny (which is default set to 400px).
Here is a demo of a shiny app where the height of the ggplot is set equal to the width of the ggplot:
mydf = data.frame(x = 1:5, y = 1:5)
# User Interface
# =================
ui <- fluidPage(theme = shinytheme('united'),
fluidRow(
column(width = 12, align = 'center',
plotOutput('myplot', height = 'auto')
)
))
# ====
# Server Code
# ==============
server <- shinyServer(function(input, output, session) {
# 3. Create the chart
# ===-===-===-===-===-===
output$myplot <- renderPlot({
ggplot(mydf, aes(x = x, y = x)) + geom_point()
}, height = function() { session$clientData$output_myplot_width })
})
# ====
shinyApp(ui, server)
Play around with the width of the window launched by launching this shiny app. By setting height = 'auto' in the UI, and then setting height = function() { session$clientData$output_myplot_width } in the Server, the height is dynamically updated. Very good indeed.
I am working on something similar in plotly, however a significant constraint that I have is that I currently need to pass a parameter for height and width to my call of plotly(), due to the very specific way I am trying to display the markers on my plot. An example of what I am trying to do is as such:
mydf <- data.frame(x = 1:5, y = 1:5)
myplotlyfunction <- function(mydf, myplotheight) {
plot_ly(mydf, height = myplotheight, width = myplotheight * 1.2) %>%
add_trace(x = ~x, y = ~y, type = 'scatter', mode = 'markers')
}
# User Interface
# =================
ui <- fluidPage(theme = shinytheme('united'),
fluidRow(
column(width = 12, align = 'center',
plotlyOutput('myplotly')
)
))
# ====
# Server Code
# ==============
server <- shinyServer(function(input, output, session) {
# 3. Create the chart
# ===-===-===-===-===-===
output$myplotly <- renderPlotly({
this.height <- 600
myplotlyfunction(mydf, myplotheight = this.height)
})
})
# ====
shinyApp(ui, server)
The specific reason why I need to pass a height and width parameter to the plot_ly() call is deserving of a post of its own, and unfortunately I haven't thought of a work around yet. Here is a real example of my plot_ly output -
At a high level, the marker size parameter for plot_ly scatter plots sets the marker sizes based on pixels, and my plot needs very specifically sized markers, and these marker sizes are therefore a function of the plot size.
Here is my attempt to make my plot_ly plots dynamic in Shiny, despite having to initially pass a fixed parameter to the plot_ly height. The idea is motivated on the initial ggplot() dynamic height function:
mydf <- data.frame(x = 1:5, y = 1:5)
myplotlyfunction <- function(mydf, myplotheight) {
plot_ly(mydf, height = myplotheight, width = myplotheight * 1.2) %>%
add_trace(x = ~x, y = ~y, type = 'scatter', mode = 'markers')
}
# User Interface
# =================
ui <- fluidPage(theme = shinytheme('united'),
fluidRow(
column(width = 12, align = 'center',
plotlyOutput('myplotly', height = 'auto')
)
))
# ====
# Server Code
# ==============
server <- shinyServer(function(input, output, session) {
# 3. Create the chart
# ===-===-===-===-===-===
output$myplotly <- renderPlotly({
this.height <- function() { session$clientData$output_myplotly_width }
myplotlyfunction(mydf, myplotheight = this.height)
}, height = function() { session$clientData$output_myplotly_width })
})
# ====
shinyApp(ui, server)
This does not work, and in fact the app crashes right away.
Thank you a ton for anybody who made it to the end of this post. Any help is appreciated regarding how I can dynamically resize a plot_ly() plot in R Shiny, based on the height or width of the app window, given that the plot_ly function itself requires a height parameter. Thoughts on how to solve the underlying problem of needing a height parameter to plot_ly() in the first place are appreciated as well, but that's a separate issue (that I've posted about myself, here - Set marker size based on coordinate values, not pixels, in plotly R - and in other posts as well).
Once again, thanks a ton for any help!
I'm preparing the test application with open NY data
https://tabulinas.shinyapps.io/nyaccidents/
It has tab plotlyOutput, that render one from 8 plots.
This works perfectly on my laptop, and used to work on shinyapps server till previous week. Now app shows two plotly plots (no matter what exact plots) and when i choose the third plot it disconnects from server.
I check - if i remove plotly plots, everything works fine.
And if i choose in third times plot that i have already rendered firstly, it crashes anyway (so there is not the reason, that all plotly objects are stored in memory)
It seems that it exceed some limit, some new limit, that wasn't active before.
Or maybe there is any issue with updated versions of R core, server and packages.
Please share any idea how i can make my application works again on server!
Here is part of code, where can be an issue
#Server part:
# Button "Back"
observeEvent(input$Back, {
current <- as.numeric(input$select)
if (current > 1){
updateSelectInput(session, "select",
selected = current-1)
}
})
#button "Next"
observeEvent(input$Next, {
current <- as.numeric(input$select)
if (current < 9){
updateSelectInput(session, "select",
selected = current+1)
}
})
output$selector <- renderUI({
selectInput("select", label = h3("Select plot"),
choices = list("Plot1" = 1, "Plot2" = 2,
"Plot3" = 3, "Plot4"=4,
"Plot5"=5, "Plot6"=6, "Plot7"=7,
"Plot8"=8), selected = 1)
})
output$distPlot <- renderPlotly({
if (as.numeric(input$select)==1){
resplot <- # here code of plotly plot}
# the same for other plots
resplot
})
# UI part
tabPanel(
title= div(img(src="summary.jpg",height = 30)),
fluidPage(
fluidRow(
column(4,
uiOutput("selector"), # Selectize input with plots
actionButton("Back", label = "Back"),
actionButton("Next", label = "Next")
),
column( 8,
htmlOutput("plot_comment") # Plot comment is a text output depending on plot choosen
)),
hr(),
hr(),
plotOutput("distPlot", width = "100%", height ="100%")
)
)
It looks like this
I Would like to determine the size of the browser window in Shiny to help me layout my plot divs better. Specifically I would like to determine the aspect ratio of the window to see how many divs I should spread across the screen and it still look nice. My initial thought would be that the number of plots would be floor(width/(height-navbar_height)).
I did some looking for this and I am currently unable to locate a possible solution and am currently lead to believe that this feature is simply not present in the clientData structure. Any thoughts?
See the example below. It uses Javascript to detect the browser window size (initial size and any resize), and use Shiny.onInputChange to send the data to the server code for processing. It uses shiny:connected event to get the initial window size, as Shiny.onInputChange is not ready for use until shiny is connected.
library(shiny)
# Define UI for application that draws a histogram
ui <- shinyUI(fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
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);
});
')),
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
verbatimTextOutput("dimension_display"),
plotOutput("distPlot")
)
)
))
# Define server logic required to draw a histogram
server <- shinyServer(function(input, output) {
output$dimension_display <- renderText({
paste(input$dimension[1], input$dimension[2], input$dimension[2]/input$dimension[1])
})
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
})
# Run the application
shinyApp(ui = ui, server = server)
There is a new and much simpler way to do this since 2021: using the {shinybrowser} package. Example:
library(shiny)
ui <- fluidPage(
shinybrowser::detect(),
"Window size:",
textOutput("size")
)
server <- function(input, output, session) {
output$size <- renderText({
paste(
shinybrowser::get_width(),
"x",
shinybrowser::get_height()
)
})
}
shinyApp(ui, server)
Note that {shinybrowser} is currently on GitHub only and not yet on CRAN (should be in the near future). Note also that {shinybrowser} only gives you the initial dimensions, but will not update if the browser is resized.
Shorter version for getting window dimensions in shiny with JS from package htmlwidgets:
window_height <- JS('window.innerHeight')
window_width <- JS('window.innerWidth')