R Shiny : async downloadHandler

Question

我有一个 Shiny 的应用程序，它需要大量时间下载 zip 文件。我正在尝试使用 futures和 promises包来管理下载，以便其他用户可以在下载过程中访问应用程序。

该应用程序如下所示:

library(shiny)

ui <- fluidPage(
  downloadButton("Download", "Download")
)


server <- function(input, output){
  output$Download <- downloadHandler(
    filename = "Downloads.zip",
    content = function(file){
      withProgress(message = "Writing Files to Disk. Please wait...", {
        temp <- setwd(tempdir())
        on.exit(setwd(temp))
        files <- c("mtcars.csv", "iris.csv")

        write.csv(mtcars, "mtcars.csv")
        write.csv(iris, "iris.csv")



        zip(zipfile = file, files = files)
      })
    }
  )
}

shinyApp(ui, server)

我试过包装 write.csv里面 future功能和设置`虽然这不会引发错误，但在下载过程中其他用户无法使用该应用程序。

library(shiny)
library(promises)
library(future)
plan(multiprocess)

ui <- fluidPage(
  downloadButton("Download", "Download")
)


server <- function(input, output){
  output$Download <- downloadHandler(
    filename = "Downloads.zip",
    content = function(file){
      withProgress(message = "Writing Files to Disk. Please wait...", {
        temp <- setwd(tempdir())
        on.exit(setwd(temp))
        files <- c("mtcars.csv", "iris.csv")

        future(write.csv(mtcars, "mtcars.csv"))
        future(write.csv(iris, "iris.csv"))



        zip(zipfile = file, files = files)
      })
    }
  )
}

shinyApp(ui, server)

我也试过包装整个 downloadHandler future 内的函数函数，但我收到错误:

Error in .subset2(x, "impl")$defineOutput(name, value, label) :
Unexpected MulticoreFuture output for DownloadUnexpected MultiprocessFuture output for DownloadUnexpected Future output for DownloadUnexpected environment output for Download

我该如何处理整个 downloadHandler异步？我正在使用 Shiny 服务器的开源版本。

Answer 1

不知道你是否还需要一个答案，但我认为你已经非常接近了。我在 future 将 write.csv 和 zip 都打包了，如下所示，它适用于我的测试中的多个用户。

library(shiny)
library(promises)
library(future)
plan(multiprocess)

ui <- fluidPage(
  downloadButton("Download", "Download")
)


server <- function(input, output){
  output$Download <- downloadHandler(
    filename = "Downloads.zip",
    content = function(file){
      withProgress(message = "Writing Files to Disk. Please wait...", {
        temp <- setwd(tempdir())
        on.exit(setwd(temp))
        files <- c("mtcars.csv", "iris.csv")

        future({

        Sys.sleep(15)  
        write.csv(mtcars, "mtcars.csv")
        write.csv(iris, "iris.csv")



        zip(zipfile = file, files = files)})
      })
    }
  )
}

shinyApp(ui, server)