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

Question

我用下面的最小示例模拟的场景是允许用户在长时间运行下载时使用 Shiny 应用程序（单击numericInput<\/code>控件并查看发生的服务器端事件）（使用Sys.sleep(10)<\/code>在downloadHandler<\/code>中)。

在同步设置中，当单击“下载”按钮时，用户仍然可以与 UI 元素交互，但其他 Shiny 计算（在本例中为renderText<\/code> ）会被放入队列中。 我想要异步设置，下载发生在后台，用户仍然可以与 UI 元素交互并<\/strong>获得所需的输出（例如renderText<\/code> ）。

我正在使用callr::r_bg()<\/code>在 Shiny 中实现异步，但问题是我当前的 downloadHandler 代码不正确（应该下载mtcars<\/code> ，但代码无法完成下载，404 错误消息） ，我相信这是由于downloadHandler<\/code>期望编写content()<\/code>函数的特定方式，而我编写callr::r_bg()<\/code>的方式并不能很好地适应它。 任何见解将不胜感激！

参考：<\/strong>

https:\/\/www.r-bloggers.com\/2020\/04\/asynchronous-background-execution-in-shiny-using-callr\/<\/a>

最小的例子：<\/strong>

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

我想出了一个解决方案，并学到了以下几点：

• 因为 downloadHandler 没有传统的input$X ，所以很难以传统方式包含反应性。 解决方法是将 UI 呈现为隐藏的actionButton ，被用户将看到的downlodButton掩盖。 在以下过程中促进了反应性：用户单击 actionButton -> 反应性更新 -> 当反应性完成时（ reactive()$is_alive() == FALSE ），使用shinyjs::click启动downloadHandler
• 我没有将callr函数放在 downloadHandler 中，而是将文件保存在内容 arg 中。 范围界定似乎有些困难，因为文件需要在content功能环境中可用
• 我正在使用反应函数来跟踪后台作业（长时间运行的计算）何时完成以使用以下语法启动下载： reactive()$is_alive()
• invalidateLater()和全局变量（ download_once ）的切换对于防止反应性不断激活很重要。 没有它，将会发生什么是您的浏览器会无限地不断下载文件——这种行为是可怕的，对于您的 Shiny 应用程序用户来说，它看起来像病毒一样！
• 请注意，设置全局变量不是 Shiny 应用程序的最佳实践（会想到更好的实现）

代码解决方案：

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

感谢@latlio 的精彩回答。 我认为它的云很容易改进。 invalidateLater应该非常小心地使用，并且只在需要时使用。 我只有一次invalidateLater并将其移至我们正在等待结果的逻辑部分。 因此，我们不会无限地使反应性无效。

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)