我在下面的最小示例中模拟的场景是允许用户使用闪亮的应用程序(单击numericInput控件并看到服务器端事件发生),同时进行长时间运行的下载( Sys.sleep(10)在downloadHandler中进行模拟)。
在同步设置中,当单击"Download“按钮时,用户仍然可以与UI元素交互,但是其他闪亮的计算(在本例中是renderText)会被放到队列中。我想要异步设置,下载在后台进行,用户仍然可以与UI元素和获得所需的输出(例如renderText)进行交互。
我正在使用callr::r_bg()来实现闪亮内部的异步性,但问题是我当前的downloadHandler代码是不正确的(mtcars应该被下载,但是代码无法完成下载,404错误消息),我相信这是由于downloadHandler期望content()函数编写的特定方式,而我编写callr::r_bg()的方式没有很好地处理这个问题。任何见解都将不胜感激!
参考:
https://www.r-bloggers.com/2020/04/asynchronous-background-execution-in-shiny-using-callr/
最小示例:
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)发布于 2021-11-03 19:30:26
我想出了一个解决方案,并学到了以下几点:
input$X,所以很难以传统的方式包含反应性。解决方法是将UI呈现为隐藏的downlodButton,由用户将看到的actionButton屏蔽。在以下过程中促进了反应性:用户单击actionButton -> Reactivity (当反应性完成(reactive()$is_alive() == FALSE)时),使用shinyjs::click启动将callr函数放置在downloadHandler中的callr函数,我将文件保存在内容arg中。定义范围似乎有一些困难,因为文件需要在environmentreactive()$is_alive()invalidateLater()和切换全局变量(download_once)对于防止反应性不断激活非常重要。没有它,你的浏览器就会无止境地下载文件--这种行为是可怕的,并且会出现病毒--就像你闪亮的应用程序用户一样!代码解决方案:
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(download_once)) {
shinyjs::click("download")
download_once <<- FALSE
}
invalidateLater(millis = 1, session = session)
}
return(x)
})
output$did_it_work <- renderText({
check()
})
}
shinyApp(ui, server)发布于 2022-01-31 19:26:25
谢谢你的回答。我认为云很容易改进。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)https://stackoverflow.com/questions/69760709
复制相似问题