Shiny中时间序列动画卡顿：如何避免整图重绘？

你当前的Shiny应用通过sliderInput实现时间序列折线图动画，但每次滑块变动都会重绘完整图表，导致卡顿。以下是两种无需重绘整图的平滑实现方案：

方案一：使用Plotly实现局部数据更新 #

Plotly支持在Shiny中通过plotlyProxy仅更新图表数据，而非重绘整个图表，能大幅提升动画流畅度。

完整代码 #

library(dplyr)
library(plotly)
library(shiny)

# 生成模拟数据
data <- expand.grid(
  Date = seq(as.Date("2001-01-01"), as.Date("2001-12-31"), "1 day"), 
  Var = c("Variable1", "Variable2"), 
  Group = c("a", "b")
) %>%
  mutate(
    Val = rnorm(n(), 0, 1),
    Val = ifelse(Group == "b", Val * 2, Val)
  )

# 预处理：按Var拆分数据，方便分面
data_list <- split(data, data$Var)

server <- function(input, output, session) {
  # 初始化基础图表
  output$Plot <- renderPlotly({
    p_list <- lapply(names(data_list), function(var) {
      df <- data_list[[var]]
      plot_ly(df, x = ~Date, y = ~Val, color = ~Group, type = "scatter", mode = "lines") %>%
        layout(title = var, yaxis = list(title = ""))
    })
    subplot(p_list, nrows = 2, shareX = TRUE, margin = 0.05) %>%
      layout(xaxis = list(title = "Date", range = range(data$Date)))
  })
  
  # 使用plotlyProxy更新数据
  observeEvent(input$DateSlider, {
    req(input$DateSlider)
    filtered_data <- data %>% filter(Date <= input$DateSlider)
    filtered_list <- split(filtered_data, filtered_data$Var)
    
    proxy <- plotlyProxy("Plot", session)
    
    # 逐个更新分面的轨迹数据
    lapply(seq_along(filtered_list), function(i) {
      df <- filtered_list[[i]]
      groups <- unique(df$Group)
      lapply(seq_along(groups), function(j) {
        group_df <- df %>% filter(Group == groups[j])
        proxy %>% plotlyProxyInvoke(
          "restyle",
          list(x = list(group_df$Date), y = list(group_df$Val)),
          list((i-1)*2 + (j-1)) # 对应分面中的轨迹索引
        )
      })
    })
  })
}

ui <- fluidPage(
  fluidRow(
    column(7, plotlyOutput("Plot", width = "100%")),
    column(3, sliderInput(
      "DateSlider", "动画周期",
      min = min(data$Date), max = max(data$Date), step = 1,
      value = min(data$Date), animate = animationOptions(loop = FALSE, interval = 100)
    ))
  )
)

shinyApp(ui, server)

原理说明 #

• 初始化时绘制包含所有数据的基础框架，固定坐标轴范围和分面布局
• 滑块变动时，仅通过plotlyProxy更新每个轨迹的x和y数据，不重绘整个图表框架，实现平滑过渡

方案二：使用gganimate预生成动画 #

如果不需要交互控制滑块（仅需自动播放动画），可以用gganimate预先生成流畅的动画，再在Shiny中展示。

代码示例 #

library(dplyr)
library(ggplot2)
library(gganimate)
library(shiny)

data <- expand.grid(
  Date = seq(as.Date("2001-01-01"), as.Date("2001-12-31"), "1 day"), 
  Var = c("Variable1", "Variable2"), 
  Group = c("a", "b")
) %>%
  mutate(
    Val = rnorm(n(), 0, 1),
    Val = ifelse(Group == "b", Val * 2, Val)
  )

# 预生成动画
anim <- ggplot(data) +
  geom_line(aes(x = Date, y = Val, group = Group, colour = Group)) +
  facet_wrap(~ Var, scales = "free_y", ncol = 1) +
  scale_x_date("Date", limits = range(data$Date)) +
  transition_reveal(Date) + # 按日期逐步展示折线
  ease_aes("linear")

# 保存为gif（也可直接在Shiny中渲染）
anim_save("timeseries_anim.gif", anim)

server <- function(input, output, session) {
  output$Plot <- renderImage({
    list(src = "timeseries_anim.gif", contentType = "image/gif", width = "100%")
  }, deleteFile = FALSE)
}

ui <- fluidPage(
  fluidRow(
    column(7, imageOutput("Plot", width = "100%")),
    column(3, tags$p("预生成平滑时间序列动画"))
  )
)

shinyApp(ui, server)

原理说明 #

• transition_reveal函数实现折线随日期逐步延伸的效果，gganimate内部优化了动画帧的过渡逻辑，生成的动画天然流畅
• 适合无需实时交互调整滑块的场景，预生成后直接在Shiny中展示即可

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