Is it possible to change downloading behavior for large PNG files?

Viewed 184

In my Shiny app, I produce a plot that is quite heavy. When I want to download this plot, R first produces the PNG file in the background and then opens the file system to choose where I want to save it.

The problem is that the plot creation takes some time after clicking on the download button, and therefore the user doesn't know if it worked.

Example below: the plot is a bit heavy so it takes some time to appear. Wait for it to appear before clicking on the "download" button.

library(shiny)
library(ggplot2)

foo <- data.frame(
  x = sample(seq(1, 20, by = 0.01), 5*1e5, replace = TRUE),
  y = sample(seq(1, 20, by = 0.01), 5*1e5, replace = TRUE)
)

ui <- fluidPage(
  downloadButton('foo'),
  plotOutput("test")
)

server <- function(input, output) {
  output$test <- renderPlot(ggplot(foo, aes(x, y)) + geom_point())
  output$foo = downloadHandler(
    filename = 'test.png',
    content = function(file) {
      ggsave(file)
    }
  )
}

shinyApp(ui, server)

Is there a way to invert the process, i.e first let the user choose where to save the plot and then produce the PNG in the background? I think that would provide a better user experience.

2 Answers

Regarding your comment below @manro's answer: promises won't help here.

They are preventing other shiny sessions from being blocked by a busy session. They increase inter-session responsiveness not intra-session responsiveness - although there are (potentially dangerous) workarounds.

See this answer for testing: R Shiny: async downloadHandler

In the end the downloadButton just provides a link (a-tag) with a download attribute.

If the linked resource does not exist when the client tries to access it the browser will throw an error (as it does when clicking the downloadButton before the plot is ready in your MRE). Also the dialog to provide the file path is executed by the clients browser after clicking the link (and not by R).

I think somehow notifying the user is all you can do:

library(shiny)
library(ggplot2)

foo <- data.frame(
  x = sample(seq(1, 20, by = 0.01), 1e5, replace = TRUE),
  y = sample(seq(1, 20, by = 0.01), 1e5, replace = TRUE)
)

ui <- fluidPage(
  tags$br(),
  conditionalPanel(condition = 'output.test == null', tags$b("Generating plot...")),
  conditionalPanel(condition = 'output.test != null', downloadButton('foo'), style = "display: none;"),
  plotOutput("test")
)

server <- function(input, output, session) {

  output$test <- renderPlot(ggplot(foo, aes(x, y)) + geom_point())
  output$foo = downloadHandler(
    filename = 'test.png',
    content = function(file) {
      showNotification(
        ui = tags$b("Preparing download..."),
        duration = NULL,
        closeButton = TRUE,
        id = "download_notification",
        type = "message",
        session = session
      )
      ggsave(file)
      removeNotification(id = "download_notification", session = session)
    }
  )
}

shinyApp(ui, server)

result

This is my first Shiny App, so I'm sure it could be improved ;)

I think, that from the point of UX - it is better to do in the following way: "display a graph -> save the graph"


An addition:

So, I added a busy spinner, now an user of this app can know that this graph still rendering. You can use several styles, choose your favourite there:


library(shiny)
library(ggplot2)
library(shinybusy)

#your data  
df <- data.frame(
  x <- sample(seq(1, 20, by = 0.01), 5*1e5, replace = TRUE),
  y <- sample(seq(1, 20, by = 0.01), 5*1e5, replace = TRUE)
)

#your plot
plot_df <- ggplot(df, aes(x, y)) + geom_point() 

#my plot 
my_plot <- ggplot(diamonds, aes(price, fill = cut)) +
              geom_histogram(binwidth = 500)

ui <- fluidPage(
      #our buttons
      br(),
      actionButton("button1", label = "View graph"),
      br(),
      br(),
      plotOutput("button1"),
      uiOutput("button2"),
      add_busy_spinner(spin = "fading-circle")      
      )

server <- function(input, output) {
              
       observeEvent(input$button1, {
         output$button1 <- renderPlot(my_plot)
         output$button2 <- renderUI({
           br()               
           downloadButton("button3")
         })
       })
       
       output$button3 <- downloadHandler(
          filename <- 'test.png',
          content <- function(file){
                    ggsave(file)
          }
       )
}

shinyApp(ui, server)

enter image description here

Related