如何在Shiny应用执行长计算时保持与其他元素的交互？

我有一段执行耗时较长的Shiny应用代码，点击“Go”按钮会触发长时间计算，另有一个“+”按钮，点击后可递增文本框中显示的数值。想了解是否有方法在长计算过程中仍能与应用的其他元素进行交互。

用户提供的原代码：

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

  observeEvent(input$go, {

      num_cores <- detectCores(); cl <- makeCluster(num_cores); registerDoParallel(cl)

      l <- as.list(as.character(1:10)); groups <- as.integer(gl(length(l), 3, length(l))); chunk <- split(l, groups)
    
      output$plot <- renderPlot({
        withProgress(message = 'Calculation in progress',
                     detail = 'This may take a while...', value = 0, {
                       for (i in 1:length(chunk)) {
                         subl <- chunk[[i]]
                         res <- foreach(j = 1:length(subl), .combine = 'rbind',
                                        .packages = c("dplyr", "caret")) %dopar% {
                                          return(data.frame("index" = (i-1)*3 + j))}
                         print(res)
                         incProgress(1/length(l))
                         Sys.sleep(0.5)
                       }
                       env <- foreach:::.foreachGlobals; rm(list=ls(name=env), pos=env); stopCluster(cl)
                     })
        plot(cars)
      })
    })

  values <- reactiveValues(counter = 0); 
  observeEvent(input$inc, { values$counter <- values$counter + 1 })
  output$value <- renderText({ values$counter })

}

app_ui <- function(request) { actionButton("go", "Go"), plotOutput("plot"), actionButton("inc", "+"), textOutput("value"))}

界面截图：

核心问题是长时间计算阻塞了Shiny的主进程，导致UI无法响应其他交互。通过异步任务将计算逻辑放到后台进程执行，即可保持UI的可交互性，以下是最简洁的实现方案：

修改后的完整可运行代码 #

library(shiny)
library(promises)
library(future)
library(foreach)
library(doParallel)

# 启用多会话异步处理，将计算任务分配到后台进程
plan(multisession)

app_server <- function(input, output, session) {
  # 计数器逻辑保持不变，主进程不阻塞即可正常响应
  values <- reactiveValues(counter = 0)
  observeEvent(input$inc, {
    values$counter <- values$counter + 1
  })
  output$value <- renderText({ values$counter })

  # 异步处理长计算任务
  observeEvent(input$go, {
    output$plot <- renderPlot({
      # 用future包裹耗时计算，放到后台执行
      future({
        num_cores <- detectCores()
        cl <- makeCluster(num_cores)
        registerDoParallel(cl)
        
        l <- as.list(as.character(1:10))
        groups <- as.integer(gl(length(l), 3, length(l)))
        chunk <- split(l, groups)
        
        # 模拟耗时计算过程
        for (i in 1:length(chunk)) {
          subl <- chunk[[i]]
          res <- foreach(j = 1:length(subl), .combine = 'rbind',
                         .packages = c("dplyr", "caret")) %dopar% {
                           data.frame("index" = (i-1)*3 + j)
                         }
          print(res)
          Sys.sleep(0.5)
        }
        
        # 清理计算资源
        env <- foreach:::.foreachGlobals
        rm(list=ls(name=env), pos=env)
        stopCluster(cl)
        
        # 返回绘图用的数据
        cars
      }) %...>% { # 计算完成后异步回调绘图
        plot(.)
      } %>% catch(function(e) {
        # 异常处理
        plot(1, main = paste("计算出错：", e$message))
      })
    })
    
    # 独立的进度条提示（可选，可根据后台任务进度动态更新）
    withProgress(message = '计算中', detail = '请稍候...', value = 0, {
      for (i in 1:10) {
        incProgress(0.1)
        Sys.sleep(0.5)
      }
    })
  })
}

# 修正原UI的语法错误，添加fluidPage容器
app_ui <- function(request) {
  fluidPage(
    actionButton("go", "Go"),
    plotOutput("plot"),
    actionButton("inc", "+"),
    textOutput("value")
  )
}

shinyApp(app_ui, app_server)

关键修改说明 #

• 引入promises和future包，通过plan(multisession)将计算任务剥离到后台进程，避免阻塞主UI线程
• 用future()包裹耗时计算逻辑，%...>%指定计算完成后的绘图回调，全程不占用主进程资源
• 原计数器逻辑无需改动，主进程空闲时会立即响应“+”按钮的点击事件
• 进度条可独立运行，也可结合后台任务的进度反馈实现更精准的更新

其他可选方案 #

• 使用callr包创建完全独立的R进程执行计算，通过消息传递返回结果，适合超大型计算任务
• 用shinyjs添加按钮禁用/启用逻辑，优化用户体验（但无法解决核心阻塞问题）

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