如何将API调用进度传递至Shiny的waiter组件并解决UI无更新问题

核心问题 #

1. Future执行模式阻塞UI：默认future采用sequential计划，耗时API请求仍在Shiny主线程运行，直接阻塞UI更新。
2. 循环执行无间隙：原代码的for循环瞬间完成，Shiny没有机会在每次进度更新后刷新UI，导致进度条无法动态变化。
3. 状态检查时机过早：循环启动时future还未开始执行，直接跳过所有进度更新逻辑。

修正代码 #

library(shiny)
library(waiter)
library(promises)
library(future)

# 设置多会话计划，将耗时操作转移到后台线程
plan(multisession)

foo <- function() {
  # 模拟慢速下载
  cap_speed <- httr::config(max_recv_speed_large = 10000)
  x <- httr::GET("http://httpbin.org/bytes/102400", httr::progress(con = stderr()), cap_speed)
}

ui <- fluidPage(
  useWaiter(),
  useHostess(),
  waiterShowOnLoad(
    color = "#f7fff7",
    hostess_loader(
      "loader", 
      preset = "circle", 
      text_color = "black",
      class = "label-center",
      center_page = TRUE
    )
  )
)

server <- function(input, output, session){
  hostess <- Hostess$new("loader")
  progress_val <- reactiveVal(0)
  
  # 启动后台API请求任务
  f <- future({ foo() })
  
  # 定期检查任务状态并更新进度
  observe({
    invalidateLater(300, session) # 每300毫秒触发一次检查
    
    if(future::resolved(f)) {
      hostess$set(100)
      waiter_hide()
    } else {
      current <- progress_val()
      if(current < 90) { # 预留最后10%给任务完成时的最终更新
        new_val <- current + 10
        progress_val(new_val)
        hostess$set(new_val)
      }
    }
  })
}

shinyApp(ui, server)

关键改进点 #

• plan(multisession)：将API请求转移到独立线程执行，彻底避免阻塞Shiny主线程，保证UI能实时响应进度更新。
• invalidateLater：通过定时触发观察者，让服务器有间隙更新UI，而非一次性跑完所有逻辑。
• reactiveVal维护进度：用响应式变量跟踪进度值，确保每次更新都能触发UI组件刷新。

进阶：捕获真实API请求进度 #

如果需要获取httr请求的真实下载进度（而非模拟进度），可修改foo函数，通过自定义回调将进度发送回Shiny：

foo <- function(progress_callback) {
  cap_speed <- httr::config(max_recv_speed_large = 10000)
  x <- httr::GET(
    "http://httpbin.org/bytes/102400",
    httr::progress(
      con = function(down, up) {
        if(!is.null(down$total)) {
          # 计算并返回当前下载进度百分比
          progress <- round((down$received / down$total) * 100)
          progress_callback(progress)
        }
      }
    ),
    cap_speed
  )
}

服务器端调整逻辑接收真实进度：

server <- function(input, output, session){
  hostess <- Hostess$new("loader")
  
  # 启动后台任务并传递进度回调
  future({
    foo(function(p) {
      session$sendCustomMessage("update_progress", p)
    })
  }) %>% then(function(res) {
    hostess$set(100)
    waiter_hide()
  })
  
  # 接收进度消息并更新组件
  session$onMessage("update_progress", function(p) {
    hostess$set(p)
  })
}

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