如何在Shiny进度条上展示真实的服务端加载进度？

核心思路是将服务端初始化阶段的所有实际任务按权重拆分进度占比，每完成一个阶段就同步更新进度条数值，替代原有的模拟等待逻辑。

具体实现方案 #

• 方案1：任务拆分进度映射（最常用，适合绝大多数场景）
  先梳理服务端初始化需要完成的所有任务，为每个任务分配对应的进度占比（总占比100%），每完成一个任务就调用hostess$set()更新当前进度。如果需要展示实际耗时，可以在服务端初始化时记录启动时间戳，每次更新进度时计算已运行时长，同步更新进度条文本即可。
  改造后示例代码如下：

  library(shiny)
  library(waiter)
  
  moduleServer <- function(id, module) {
     callModule(module, id)
  }
  
  mod_ui <- function(id) {
     ns <- NS(id)
     
     tagList(  
        url <- "https://www.freecodecamp.org/news/content/images/size/w2000/2020/04/w-qjCHPZbeXCQ-unsplash.jpg",
        
        use_waiter(),
        use_hostess(),
        waiter_preloader(image = url,
                         hostess_loader(
                            id = ns("loader"),
                            preset = "circle",
                            text_color = "white",
                            class = "label-center",
                            center_page = TRUE))
     )
  }
  
  # 服务端使用真实任务替换模拟逻辑
  mod_server <- function(id){
     moduleServer(id, function(input, output, session) {
        ns <- session$ns
        hostess <- Hostess$new(ns("loader"))
        # 记录初始化开始时间，用于计算耗时
        start_time <- Sys.time()
        
        # --- 真实初始化任务开始 ---
        # 任务1：加载2个本地大数据集，占总进度20%
        # data1 <- read.csv("large_data1.csv")
        # data2 <- read.csv("large_data2.csv")
        Sys.sleep(1) # 这里仅模拟任务耗时，实际使用时替换为真实代码
        current_progress <- 20
        cost_time <- round(difftime(Sys.time(), start_time, units = "secs"), 1)
        hostess$set(current_progress, text = paste0(current_progress, "%\n已耗时：", cost_time, "s"))
        
        # 任务2：连接数据库拉取业务数据，占总进度30%
        # con <- DBI::dbConnect(RMySQL::MySQL(), host = "xxx", user = "xxx", password = "xxx")
        # biz_data <- DBI::dbGetQuery(con, "SELECT * FROM large_table")
        Sys.sleep(1.5) # 模拟耗时，实际替换为真实代码
        current_progress <- 50
        cost_time <- round(difftime(Sys.time(), start_time, units = "secs"), 1)
        hostess$set(current_progress, text = paste0(current_progress, "%\n已耗时：", cost_time, "s"))
        
        # 任务3：数据预处理、衍生指标计算，占总进度30%
        # clean_data <- biz_data %>% filter(xxx) %>% mutate(xxx = xxx)
        Sys.sleep(2) # 模拟耗时，实际替换为真实代码
        current_progress <- 80
        cost_time <- round(difftime(Sys.time(), start_time, units = "secs"), 1)
        hostess$set(current_progress, text = paste0(current_progress, "%\n已耗时：", cost_time, "s"))
        
        # 任务4：初始化输出对象基础配置，占总进度20%
        # output$plot1 <- renderPlot({xxx})
        # output$table1 <- renderTable({xxx})
        Sys.sleep(0.8) # 模拟耗时，实际替换为真实代码
        current_progress <- 100
        cost_time <- round(difftime(Sys.time(), start_time, units = "secs"), 1)
        hostess$set(current_progress, text = paste0(current_progress, "%\n总耗时：", cost_time, "s"))
        # --- 真实初始化任务结束 ---
        
        waiter_hide()
     })
  
  }
  
  # App #
  ui <- fluidPage(
     mod_ui("test_ui")
  )
  
  server <- function(input, output, session) {
     mod_server("test_ui")
  }
  
  shinyApp(ui = ui, server = server)
  

  进度占比的分配可根据本地测试各个任务的实际耗时占比设置，能最大程度贴近真实加载进度，避免出现进度条提前满负荷但任务未完成的问题。

• 方案2：单一大任务进度回调
  如果要执行的是不可拆分的单一大计算任务（比如训练机器学习模型、读取超大单文件），可以调用对应工具包自带的进度回调接口，将回调返回的完成度映射到0-100的范围，同步更新到hostess$set()即可。比如readr::read_csv()的进度回调、caret训练模型的trainControl回调等，都可以获取实时进度。

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