"如何在 Shiny App 的 downloadHandler 中使用 callr::r_bg"

Question

The scenario I'm emulating with the below minimal example is allowing a user to engage with a Shiny App (click the numericInput<\/code> control and see server-side events occur) while a long-running download is occurring (simulated with Sys.sleep(10)<\/code> within downloadHandler<\/code> ).

library(shiny)

ui <- fluidPage(
  downloadButton("download", "Download"),
  
  numericInput("count",
               NULL,
               1,
               step = 1),
  
  textOutput("text")
)

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

  long_download <- function(file) {
    Sys.sleep(10)
    write.csv(mtcars, file)
  }
  
  output$download <- downloadHandler(
    filename = "data.csv",
    content = function(file) {
      x <- callr::r_bg(
        func = long_download,
        args = list(file)
      )
      return(x)
    }
  )
  
  observeEvent(input$count, {
    output$text <- renderText({
      paste(input$count)
    })
  })
  
}

shinyApp(ui, server)

Answer 1

I figured out a solution, and learned the following things:

• Because downloadHandler doesn't have a traditional input$X , it can be difficult to include reactivity in the traditional way. The workaround was to present the UI as a hidden downlodButton masked by an actionButton which the user would see. Reactivity was facilitated in the following process: user clicks actionButton -> reactive updates -> when the reactive finishes ( reactive()$is_alive() == FALSE ), use shinyjs::click to initiate the downloadHandler
• Instead of placing the callr function within the downloadHandler, I kept the file within the content arg. There seems to be some difficulties with scoping because the file needs to be available within the content function environment
• I'm using a reactive function to track when the background job (the long-running computation) is finished to initiate the download using the syntax: reactive()$is_alive()
• The invalidateLater() and toggling of a global variable ( download_once ) is important to prevent the reactive from constantly activating. Without it, what will happen is your browser will continually download files ad infinitum -- this behavior is scary and will appear virus-like to your Shiny app users!
• Note that setting global variables is not a best practice for Shiny apps (will think of a better implementation)

Code Solution:

library(shiny)
library(callr)
library(shinyjs)

ui <- fluidPage(
  shinyjs::useShinyjs(),
  #creating a hidden download button, since callr requires an input$,
  #but downloadButton does not natively have an input$
  actionButton("start", "Start Long Download", icon = icon("download")),
  downloadButton("download", "Download", style = "visibility:hidden;"),

  p("You can still interact with app during computation"),
  numericInput("count",
               NULL,
               1,
               step = 1),
  
  textOutput("text"),
  
  textOutput("did_it_work")
)

long_job <- function() { 
  Sys.sleep(5)
}

server <- function(input, output, session) {
  
  #start async task which waits 5 sec then virtually clicks download
  long_run <- eventReactive(input$start, {
    #r_bg by default sets env of function to .GlobalEnv
    x <- callr::r_bg(
      func = long_job,
      supervise = TRUE
    )
    return(x)
  })
  
  #desired output = download of mtcars file
  output$download <- downloadHandler(filename = "test.csv",
                                     content = function(file) {
                                       write.csv(mtcars, file)
                                     })
  
  #output that's meant to let user know they can still interact with app
  output$text <- renderText({
    paste(input$count)
  })
  
  download_once <- TRUE
  
  #output that tracks progress of background task
  check <- reactive({
    invalidateLater(millis = 1000, session = session)
    
    if (long_run()$is_alive()) {
      x <- "Job running in background"
    } else {
      x <- "Async job in background completed"
    
      if(isTRUE(test)) {
        shinyjs::click("download")
        download_once <<- FALSE
      }
      invalidateLater(millis = 1, session = session)
    }
    return(x)
  })
  
  output$did_it_work <- renderText({
    check()
  })
}

shinyApp(ui, server)

Answer 2

Thanks @latlio for your great answer. I think it cloud be easily improved. invalidateLater should be used very carefully and only WHEN needed. I only once invalidateLater and moved it to logical part where we are waiting for results. Thus we are NOT invalidating the reactivity infinitely.

library(shiny)
library(callr)
library(shinyjs)

ui <- fluidPage(
  shinyjs::useShinyjs(),
  #creating a hidden download button, since callr requires an input$,
  #but downloadButton does not natively have an input$
  actionButton("start", "Start Long Download", icon = icon("download")),
  downloadButton("download", "Download", style = "visibility:hidden;"),
  
  p("You can still interact with app during computation"),
  numericInput("count",
               NULL,
               1,
               step = 1),
  
  textOutput("text"),
  
  textOutput("did_it_work")
)

long_job <- function() { 
  Sys.sleep(5)
}

server <- function(input, output, session) {
  
  #start async task which waits 5 sec then virtually clicks download
  long_run <- eventReactive(input$start, {
    #r_bg by default sets env of function to .GlobalEnv
    x <- callr::r_bg(
      func = long_job,
      supervise = TRUE
    )
    return(x)
  })
  
  #desired output = download of mtcars file
  output$download <- downloadHandler(filename = "test.csv",
                                     content = function(file) {
                                       write.csv(mtcars, file)
                                     })
  
  #output that's meant to let user know they can still interact with app
  output$text <- renderText({
    paste(input$count)
  })
  
  #output that tracks progress of background task
  check <- reactive({
    if (long_run()$is_alive()) {
      x <- "Job running in background"
      invalidateLater(millis = 1000, session = session)
    } else {
      x <- "Async job in background completed"
      shinyjs::click("download")
    }
    return(x)
  })
  
  output$did_it_work <- renderText({
    check()
  })
}

shinyApp(ui, server)