R Shiny非可视区域图表懒加载实现方法问询

要解决Shiny应用中所有图表同时渲染导致的加载缓慢问题，我们可以借助JavaScript Intersection Observer API，实现仅当图表容器进入可视区域时才触发渲染的懒加载效果。以下是具体实现方案：

核心思路 #

1. 用Intersection Observer监听每个图表的输出容器，检测其是否进入用户视口
2. 当容器进入视口时，向Shiny后端发送信号，标记该图表需要渲染
3. 后端仅在收到对应信号后，才执行该图表的渲染逻辑

修改后的完整代码 #

library(plotly)
library(shiny)

ui <- fluidPage(
  sliderInput("points_no", "Number of points", 5, 50, 10),
  # 图表容器保持不变
  plotlyOutput("plot1"),
  plotlyOutput("plot2"),
  plotlyOutput("plot3"),
  plotlyOutput("plot4"),
  plotlyOutput("plot5"),
  plotlyOutput("plot6"),
  
  # 添加自定义JavaScript实现懒加载监听
  tags$script(HTML("
    // 创建Intersection Observer实例
    const observer = new IntersectionObserver((entries) => {
      entries.forEach(entry => {
        if (entry.isIntersecting) {
          // 当元素进入视口时，通知Shiny需要渲染该图表
          Shiny.setInputValue('render_plot', entry.target.id);
          // 只监听一次，避免重复触发初始渲染
          observer.unobserve(entry.target);
        }
      });
    }, { threshold: 0.1 }); // 元素可见10%时触发

    // 监听所有plot开头的输出容器
    document.querySelectorAll('[id^=\"plot\"]').forEach(el => {
      observer.observe(el);
    });
  "))
)

server <- function(input, output, session) {
  # 跟踪哪些图表需要渲染
  render_plots <- reactiveValues(
    plot1 = FALSE, plot2 = FALSE, plot3 = FALSE,
    plot4 = FALSE, plot5 = FALSE, plot6 = FALSE
  )
  
  # 接收前端传来的渲染信号，标记对应图表为待渲染
  observeEvent(input$render_plot, {
    plot_id <- input$render_plot
    render_plots[[plot_id]] <- TRUE
  })
  
  # 生成图表的基础逻辑（复用原代码）
  plot_object <- reactive({
    plot_df <- data.frame(x = 1:input$points_no,
                          y = rnorm(input$points_no))
    
    plot_ly(plot_df, x = ~x, y = ~y) |> 
      add_markers()
  })
  
  # 每个图表的渲染逻辑：仅当标记为需要渲染时才执行
  output$plot1 <- renderPlotly({
    if (!render_plots$plot1) return(NULL)
    Sys.sleep(1)
    plot_object()
  })
  
  output$plot2 <- renderPlotly({
    if (!render_plots$plot2) return(NULL)
    Sys.sleep(1)
    plot_object()
  })
  
  output$plot3 <- renderPlotly({
    if (!render_plots$plot3) return(NULL)
    Sys.sleep(1)
    plot_object()
  })
  
  output$plot4 <- renderPlotly({
    if (!render_plots$plot4) return(NULL)
    Sys.sleep(1)
    plot_object()
  })
  
  output$plot5 <- renderPlotly({
    if (!render_plots$plot5) return(NULL)
    Sys.sleep(1)
    plot_object()
  })
  
  output$plot6 <- renderPlotly({
    if (!render_plots$plot6) return(NULL)
    Sys.sleep(1)
    plot_object()
  })
}

shinyApp(ui, server)

关键细节说明 #

• JavaScript部分：IntersectionObserver的threshold: 0.1表示当图表容器有10%进入视口时触发渲染；observer.unobserve(entry.target)确保每个图表只触发一次初始渲染，后续滑块输入变化时会自动重新渲染（因依赖input$points_no）。
• 后端逻辑：reactiveValues用于跟踪每个图表的渲染状态，renderPlotly函数先检查状态，仅当状态为TRUE时才执行耗时的渲染操作，否则返回NULL（容器保留但无内容）。
• 兼容性：该方案适用于Plotly、ggplot2、eCharts等所有Shiny输出类型，只需将plotlyOutput替换为对应输出函数即可。

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