Shiny中ggplot绘图进度条提前关闭问题咨询

问题现象 #

• 选择AllRuns选项时，进度条弹出后会在图形实际渲染显示前提前关闭
• 选择scatter选项时，进度条可正常等待至散点图在主面板加载完成后再消失

核心疑问：该现象是否为正常行为？如何调整才能让选择AllRuns选项时，进度条保持显示直到ggplot图形完全渲染展示？
补充说明：示例所用数据集从数据源读取到R环境约耗时20秒，最小可复现代码见下文。

完整可复现代码 #

library(shiny)
library(tidyverse)
library(DT)
library(data.table)

final <- fread("https://docs.google.com/spreadsheets/d/170235QwbmgQvr0GWmT-8yBsC7Vk6p_dmvYxrZNfsKqk/pub?output=csv")

runs<- c("AllRuns","scatter")

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput(inputId = "run",
                  label = "Chinook Runs",
                  choices = runs,
                  selected = "AllRuns"),
      sliderInput(inputId = "Yearslider",
                  label="Years to plot",
                  sep="",
                  min=2000,
                  max=2014,
                  value=c(2010,2012))
    ),
    mainPanel(
      plotOutput("plot")
    )
  )
)

server <- function(input, output,session) {
  session$onSessionEnded(function() {
    stopApp()
  }) 
  
  plot_all <- reactive({
    final[final$year >= input$Yearslider[1] & final$year <= input$Yearslider[2], ] 
  })
  
  plotscatter <- reactive({
    rnorm(100000)    
  })
  
  dataInput <- reactive({
    if (input$run == "AllRuns") {
      plot_all() 
    }else{
      plotscatter()
    }
  })
  
  # 生成图形
  create_plots <- reactive({
    withProgress(message="Creating graphic....",value = 0, {
      n <- 10
      for (i in 1:n) {
        incProgress(1/n, detail = input$run)
        Sys.sleep(0.1) 
      }    
      
      theme_set(theme_classic())
      switch(input$run,
             "AllRuns" = ggplot(plot_all(),aes(SampleDate,Count,color = race2)) + 
               geom_point() + theme_bw() +
               labs(x="",y="Number in thousands",title="All Salmon Runs combined"),
             "scatter" = plot(plotscatter(),col="lightblue")
      )
    })
  })
  
  output$plot <- renderPlot({
    create_plots()
  }) 
  
}
# 启动应用
shinyApp(ui = ui, server = server)

原因解释 #

该现象是Shiny和ggplot2渲染机制导致的正常表现，两类绘图逻辑的执行时机存在本质差异：

• scatter分支使用base R的plot()函数，属于即时渲染：函数运行时直接在当前绘图设备完成所有计算、绘制操作，全部流程都在withProgress()代码块的监控范围内，因此进度条会等待图形完全绘制后再关闭。
• AllRuns分支返回的是ggplot2构建的绘图对象，属于延迟渲染：withProgress()块内仅完成了绘图对象的规则定义（数据映射、图层配置等），没有触发实际渲染。ggplot对象只有被renderPlot()打印输出、推送到前端设备时才会执行真正的几何元素绘制、坐标计算等耗时操作，这部分流程发生在withProgress()块执行结束之后，因此进度条会提前关闭。

修复方法 #

在withProgress()代码块内主动触发ggplot对象的打印渲染，让所有绘图耗时都落在进度条的监控周期内即可。只需修改switch语句中AllRuns分支的代码：

switch(input$run,
       "AllRuns" = {
         # 先构建ggplot对象
         p <- ggplot(plot_all(),aes(SampleDate,Count,color = race2)) + 
           geom_point() + theme_bw() +
           labs(x="",y="Number in thousands",title="All Salmon Runs combined")
         # 主动打印对象，触发实际渲染
         print(p)
       },
       "scatter" = plot(plotscatter(),col="lightblue")
)

如果数据过滤环节耗时较长，也可以将plot_all()的数据处理步骤纳入进度条的递增逻辑中，避免数据处理阶段无加载提示。

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