如何在Shiny中通过callr::r_bg从函数内设置输出？

我有一个Shiny应用，点击按钮会触发函数生成输出，但该过程耗时较长，希望用callr::r_bg在后台运行。无callr的可运行示例正常工作，但尝试使用callr的代码中，后台进程显示已完成，界面却未出现预期文本输出。

无callr的正常代码：

library(shiny)

ui <- fluidPage(
  actionButton("click", "click me!"),
  textOutput("text")
)

server <- function(input, output, session) {
  
  call_fun <- function(input, output) {
    Sys.sleep(5)
    output$text <- renderText("Output is generated")
  }
  
  observeEvent(input$click, {
    call_fun(input, output)
  })
  
}

shinyApp(ui, server)

其中Sys.sleep(5)用于模拟耗时操作。

使用callr的尝试代码（存在问题）：

library(shiny)

ui <- fluidPage(
  actionButton("click", "click me!"),
  textOutput("text")
)

server <- function(input, output, session) {
  rv <- reactiveValues(callr = NULL)
  
  call_fun <- function(input, output) {
    Sys.sleep(5)
    output$text <- shiny::renderText("Output is generated")
  }
  
  observeEvent(input$click, {
    rv$callr <- callr::r_bg(function(input, output, call_fun) call_fun(input, output), 
                  args = list(input, output, call_fun))
  })
  
  observe({
    req(rv$callr)
    cat('\nIn Observe')
    if(rv$callr$is_alive()) {
      invalidateLater(millis = 1000, session = session)
      cat('\nProcessing')
    }
    else {
      cat("\nDone")
    }
  })
  
}

shinyApp(ui, server)

callr::r_bg会启动一个独立的R进程来执行任务，这个后台进程和主Shiny进程完全隔离：

• 后台进程中的output对象和主进程的output不是同一个实例，修改后台的output不会影响主进程的UI
• renderText是Shiny主进程的函数，在后台进程中调用无法将结果传递到前端界面

核心思路是让后台进程只负责执行耗时任务并返回结果，主Shiny进程监听后台进程的状态，当任务完成后读取返回值，再更新UI输出。修改后的代码如下：

library(shiny)
library(callr)

ui <- fluidPage(
  actionButton("click", "click me!"),
  textOutput("text")
)

server <- function(input, output, session) {
  rv <- reactiveValues(callr_process = NULL)
  
  # 后台只执行耗时操作，返回结果，不操作Shiny对象
  background_task <- function() {
    Sys.sleep(5)
    return("Output is generated")
  }
  
  observeEvent(input$click, {
    # 启动后台进程
    rv$callr_process <- r_bg(func = background_task)
  })
  
  # 监听后台进程状态，完成后更新UI
  observe({
    req(rv$callr_process)
    
    if(rv$callr_process$is_alive()) {
      invalidateLater(1000, session)
      cat('\nProcessing...')
    } else {
      cat('\nDone')
      # 读取后台返回的结果，在主进程中更新output
      output$text <- renderText(rv$callr_process$result())
    }
  })
  
}

shinyApp(ui, server)

关键修改点 #

• 将call_fun改为只返回结果的纯函数，不涉及任何Shiny对象操作
• 后台进程启动时不再传递input和output参数（如果不需要的话），避免不必要的对象传递
• 主进程在检测到后台任务完成后，调用rv$callr_process$result()获取返回值，再用renderText更新output$text

内容的提问来源于stack exchange，提问作者user16024709