Shiny R中并行进程（future、promises）异步执行异常求助

核心原因 #

你遇到的差异本质是旧版本Shiny+Promises的兼容性问题，结合响应式上下文的初始化时机导致：

1. 按钮在observeEvent内的情况：
   按钮是在点击SimulateAsyncProcesses后动态渲染的，此时异步任务已提交到后台，主进程回到事件循环，能立即响应新按钮的点击请求，自然实现异步效果。
2. 按钮在observeEvent外的情况：
   按钮在会话启动时就存在，对应的eventReactive依赖绑定在会话初始化阶段。在你使用的R 4.0.3搭配的旧版Shiny/Promises中，主进程提交异步任务后，事件循环存在阻塞bug——已绑定的输入事件请求会被排队，直到后台异步任务完成才会处理，导致热力图必须等休眠结束才生成。

另外你的代码存在潜在问题：当按钮定义在外部时，server中存在两个output$GenerateDataToPlot的定义，会造成输出覆盖，进一步干扰响应式行为。

修复方案 #

无需动态渲染按钮，通过以下调整实现稳定异步：

1. 直接在UI中定义按钮

放弃uiOutput动态生成按钮，直接在UI里写死按钮，避免响应式绑定的兼容性问题。

2. 统一异步封装

即使是简单的矩阵生成任务，也用future_promise包裹，保证主进程完全不被阻塞。

3. 升级依赖包（推荐）

R 4.0.3对应的包版本较旧，升级shiny、promises、future到兼容新版本，能彻底解决旧版的异步处理bug。

调整后的完整代码 #

library(shiny)
library(promises)
library(future)
library(DT)
library(plotly)
library(chron)

plan(multisession)

testAsyncProcess <- function(x){
  start <- Sys.time()
  Sys.sleep(x)
  end <- Sys.time()
  data.frame(
    start = as.character(times(strftime(start,"%H:%M:%S"))),
    end   = as.character(times(strftime(end,  "%H:%M:%S"))),
    duration = round(end - start,1)
  )
}

ui <- fluidPage(
  titlePanel("async test app"),
  sidebarLayout(
    sidebarPanel(width = 12,
      fluidRow(
        column(3, actionButton("SimulateAsyncProcesses", "Simulate async processes"), style = 'margin-top:25px'),
        column(4, DTOutput("ProcessInfo"))
      )
    ),
    mainPanel(width = 12,
      fluidRow(
        column(2, actionButton("GenerateDataToPlot", "Generate data to plot")),
        column(8, offset = 1, plotlyOutput("GeneratedHeatMap"))
      )
    )
  )
)

server <- function(input, output, session) {
  processInfo <- reactiveVal()
  
  # 异步生成热力图数据
  DataToPlot <- eventReactive(input$GenerateDataToPlot, {
    future_promise({
      matrix(runif(100), nrow = 10, ncol = 10)
    })
  })
  
  observeEvent(input$SimulateAsyncProcesses, {
    future_promise({testAsyncProcess(10)}) %...>% processInfo()
  })
  
  output$ProcessInfo <- renderDT({
    req(processInfo())
    datatable(processInfo(), rownames = FALSE, options = list(dom = 't'))
  })
  
  output$GeneratedHeatMap <- renderPlotly({
    req(DataToPlot())
    plot_ly(z = DataToPlot(), type = "heatmap")
  })
}

shinyApp(ui = ui, server = server)

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