如何在保留动态UI的前提下提升R Shiny中uiOutput的渲染速度？

我在《Mastering Shiny》中看到：

自行运行代码会发现，应用加载后需耗时片刻内容才会显示。这是因为它是响应式的：应用必须加载、触发响应式事件、调用服务器函数生成HTML后插入页面。这是renderUI()的缺点之一：过度依赖会导致UI卡顿。为获得良好性能，应尽可能保留固定UI部分，使用本章前文介绍的技巧。

但业务需求更倾向使用uiOutput而非固定布局，实际构建的示例应用确实出现了预期的加载延迟问题，希望在保留动态UI机制的前提下降低延迟，即使无法完全消除，也要让延迟不那么明显。

以下是针对该问题的具体优化方案：

1. 预生成静态HTML片段，减少服务器端重复计算 #

将重复的动态UI组件提前生成为HTML字符串，后续renderUI直接返回静态内容，避免每次调用sliderInput等函数时的额外开销。

修改示例代码的服务器端逻辑：

server <- function(input, output, session) {
  onFlushed(
    fun = function() {
      app_start_to_first_flushed(round(difftime(Sys.time(), app_start, units = "secs"), digits = 3L))
    }
  )
  
  output$time_difference <- renderText({
    paste("App start to first flushed event:",
          app_start_to_first_flushed(),
          "seconds")
  })
  
  # 预生成所有滑块的HTML代码
  slider_html <- lapply(slider_input_ids, function(id) {
    as.character(sliderInput(
      inputId = id,
      label = id,
      min = 1L,
      max = 10L,
      value = 1L
    ))
  })
  
  mapply(function(slider_output_id, html) {
    output[[slider_output_id]] <- renderUI({
      HTML(html)
    })
  }, slider_output_ids, slider_html, SIMPLIFY = FALSE)
}

2. 分批加载动态UI，优先展示核心内容 #

不要一次性渲染所有动态组件，先加载用户最关注的部分，剩余组件在后台异步加载，让用户先看到核心内容，降低感知延迟。

示例修改：

server <- function(input, output, session) {
  onFlushed(
    fun = function() {
      app_start_to_first_flushed(round(difftime(Sys.time(), app_start, units = "secs"), digits = 3L))
    }
  )
  
  output$time_difference <- renderText({
    paste("App start to first flushed event:",
          app_start_to_first_flushed(),
          "seconds")
  })
  
  # 先渲染前10个滑块
  lapply(1:10, function(i) {
    output[[slider_output_ids[i]]] <- renderUI({
      sliderInput(
        inputId = slider_input_ids[i],
        label = slider_input_ids[i],
        min = 1L,
        max = 10L,
        value = 1L
      )
    })
  })
  
  # 延迟加载剩余滑块
  observeEvent(session$clientData$url_search, {
    lapply(11:n_sliders, function(i) {
      output[[slider_output_ids[i]]] <- renderUI({
        sliderInput(
          inputId = slider_input_ids[i],
          label = slider_input_ids[i],
          min = 1L,
          max = 10L,
          value = 1L
        )
      })
    })
  }, once = TRUE)
}

3. 合并uiOutput，减少服务器-客户端通信次数 #

用单个uiOutput代替多个独立的uiOutput，将所有动态组件打包成一个tagList一次性返回，减少通信交互次数。

修改UI部分：

ui <- fluidPage(tags$b(
  tagAppendAttributes(textOutput("time_difference"), style = "margin-top: 20px; margin-bottom: 20px;")
),
uiOutput("all_sliders")) # 单个uiOutput替代多个

服务器端对应修改：

server <- function(input, output, session) {
  onFlushed(
    fun = function() {
      app_start_to_first_flushed(round(difftime(Sys.time(), app_start, units = "secs"), digits = 3L))
    }
  )
  
  output$time_difference <- renderText({
    paste("App start to first flushed event:",
          app_start_to_first_flushed(),
          "seconds")
  })
  
  output$all_sliders <- renderUI({
    tagList(
      lapply(slider_input_ids, function(id) {
        sliderInput(
          inputId = id,
          label = id,
          min = 1L,
          max = 10L,
          value = 1L
        )
      })
    )
  })
}

4. 添加加载状态提示，优化用户感知 #

即使延迟无法消除，通过加载动画或占位符让用户明确应用处于加载状态，避免误以为页面卡顿。可以使用shinycssloaders包的withSpinner函数：

先安装依赖包：install.packages("shinycssloaders")

修改UI：

library(shinycssloaders)

ui <- fluidPage(tags$b(
  tagAppendAttributes(textOutput("time_difference"), style = "margin-top: 20px; margin-bottom: 20px;")
),
withSpinner(uiOutput("all_sliders")))

5. 轻量JS优化：占位符替换 #

通过少量JavaScript实现页面加载时先显示占位元素，等动态UI加载完成后自动替换，减少空白等待时间：

修改UI：

ui <- fluidPage(tags$b(
  tagAppendAttributes(textOutput("time_difference"), style = "margin-top: 20px; margin-bottom: 20px;")
),
tags$div(id = "slider_placeholder", lapply(1:n_sliders, function(i) {
  tags$div(style = "height: 50px; margin: 10px 0; background: #f0f0f0; border-radius: 4px;")
})),
uiOutput("all_sliders"),
tags$script(HTML("
  $(document).on('shiny:value', function(event) {
    if (event.target.id === 'all_sliders') {
      $('#slider_placeholder').hide();
    }
  });
")))

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