Shiny能否实现与任务实际耗时同步的加载进度条或旋转动画

首先明确两个核心结论：

• 若你需要的是无需显示精确百分比的加载动画（如旋转图标），完全可以实现和实际任务耗时100%同步，无需手动预设任何时长
• 若你需要的是显示具体进度百分比的进度条，无法实现完全的自动精确同步，必须对任务做步骤拆分后手动上报进度，原因是Shiny无法自动感知一个黑箱任务（比如ggplot绘图）的内部执行进度

一、最简单的同步加载动画实现（推荐） #

你之前用的shinycssloaders、shinybusy等包都自带了绑定Shiny输出组件忙碌状态的功能，只要给需要加载提示的输出组件套上对应封装，动画会在组件计算/渲染开始时自动出现，计算结束后自动消失，完全和实际耗时匹配，不需要你写任何Sys.sleep或者循环模拟进度的代码。

以你提供的最小示例为例，用shinycssloaders修改仅需改动一行代码：
首先确保你已经安装包：install.packages("shinycssloaders")
然后修改UI中plotOutput部分即可，完整修改后的代码如下：

library(shiny)
library(magrittr)
library(DT)
library(shinybusy)
library(ggplot2)
library(shinycssloaders)

new_choices <- setNames(names(mtcars), names(mtcars))


ui <- fluidPage(
  
  # Application title
  titlePanel("Shiny app"),
  
  sidebarLayout(
    sidebarPanel(
      
      tabsetPanel(
        tabPanel("Selection",
                 selectInput("x_axis", "Choose x axis",
                             choices = new_choices),
                 
                 selectInput("y_axis", "Choose y axis",
                             choices = new_choices),
                 
                 hr(),
        ),
        
        tabPanel("Titles",
                 hr(),
                 
                 textInput(inputId = "title", "You can write the title:",  value = "This is the title"),
                 textInput(inputId = "xlab", "You can re-name the x-axis:",  value = "x-axis...."),
                 textInput(inputId = "ylab", "You can re-name the y-axis:",  value = "y-axis ...."),
                 
        ),
        
        
        tabPanel("Calculations", 
                 hr(),
                 
                 checkboxInput("log2", "Do the log2 transformation", value = F),
                 checkboxInput("sqrt", "Calculate the square root", value = F),
                 
        )
        
      ),
      actionButton(inputId = "drawplot", label = "Show the plot")
      
    ),
    
    mainPanel(
      # 仅需把plotOutput包在withSpinner中即可
      withSpinner(plotOutput("plot"), type = 1, color = "#007bc2")
    )
  )
)


server <- function(input, output, session) {
  
  data <- reactive({
    mtcars
  })
  
  
  filtered_data <- reactive({
    data <- data()
    if(input$log2 == TRUE){
      data <- log2(data+1)
    }
    if(input$sqrt == TRUE){
      data <- sqrt(data)
    }
    return(data)
    
  })
  
  
  v <- reactiveValues()
  observeEvent(input$drawplot, {
    
    v$plot <- ggplot() +
      geom_point(data = filtered_data(),
                 aes_string(x = input$x_axis, y = input$y_axis)) +
      xlab(input$xlab) +
      ylab(input$ylab) +
      ggtitle(input$title)
    
  })
  
  
  output$plot <- renderPlot({
    if (is.null(v$plot)) return()
    v$plot
  })
  
  
}

shinyApp(ui, server)

你可以替换成大数据集测试，动画的持续时长和绘图实际耗时完全一致，不需要任何手动配置。

二、如果需要带百分比的进度条 #

如果你的场景必须显示进度百分比，需要把你的任务拆分成多个可独立执行的步骤，每完成一个步骤手动更新进度，示例逻辑如下：

observeEvent(input$drawplot, {
  withProgress(message = '生成图表中', value = 0, {
    # 第一步：处理数据，占总进度30%
    incProgress(0.3, detail = "正在处理数据")
    dat <- filtered_data()
    
    # 第二步：生成绘图对象，占总进度50%
    incProgress(0.5, detail = "正在构建绘图")
    p <- ggplot() +
      geom_point(data = dat,
                 aes_string(x = input$x_axis, y = input$y_axis)) +
      xlab(input$xlab) +
      ylab(input$ylab) +
      ggtitle(input$title)
    
    # 第三步：完成收尾，占总进度20%
    incProgress(0.2, detail = "渲染完成")
    v$plot <- p
  })
})

这种方式的进度虽然不是100%精确的线性同步，但完全和实际任务执行进度绑定，不会出现进度跑完任务还在运行的问题，你可以根据自己任务各步骤的实际耗时占比调整每个步骤的进度权重。

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