R flexdashboard中添加筛选后Plotly动画地图失效求助

问题场景 #

使用flexdashboard制作时序空间数据看板，需求是添加用户筛选组件，同时展示筛选后子集按日期变化的动画地图。未添加筛选时动画运行正常，但启用filter_select筛选后，动画进度条消失。

问题原因 #

1. 当通过Crosstalk筛选数据后，部分日期帧可能没有匹配的数据，Plotly会自动移除这些空帧，导致动画进度条丢失
2. 原代码中将Date转为因子类型，筛选后剩余的因子水平（日期）不连续，干扰了Plotly动画的帧渲染逻辑

解决方案 #

1. 保留完整的日期序列：使用tidyr::complete()补全所有日期-组的组合，确保每个日期在筛选后都有对应的（即使是空的）数据条目
2. 手动控制动画帧：基于完整的日期序列生成动画帧，避免Plotly自动移除空帧
3. 保持Date为日期类型（而非因子），让Plotly正确识别时序顺序

修正后的完整代码 #

---
title: "Dashboard"
output: 
  flexdashboard::flex_dashboard:
    orientation: columns
---

```{r setup, include=FALSE}
library(crosstalk)     # 联动交互图表
library(flexdashboard) # 制作看板
library(dplyr)         # 数据处理
library(plotly)        # 交互图表
library(tidyr)         # 补全数据

# 生成数据
data <- expand.grid(Lat = c(46.5, 46.7, 46.8), 
                    Lon = seq(-110, -115, -0.5), 
                    Group = c("A", "B"),
                    Date = as.Date(c("24/02/2020", "25/02/2020", "26/02/2020", 
                                     "27/02/2020", "28/02/2020", "29/02/2020"), 
                                    format = "%d/%m/%Y")) %>%
  # 随机采样模拟真实数据缺失
  slice_sample(n = 50) %>%
  # 补全所有日期-Group组合，确保每个日期都有记录（空值也保留）
  complete(Date, Group, nesting(Lat, Lon), fill = list(Lat = NA, Lon = NA))

# 创建共享数据对象
S_data <- SharedData$new(data)

Column 1 {data-width=80} #

数据筛选 #

filter_select(
  id = "group",
  label = "选择分组",
  sharedData = S_data,
  group = ~Group,
  multiple = FALSE)

时序动画地图 #

# 获取完整的日期序列，用于生成动画帧
all_dates <- unique(data$Date)

# 基于共享数据构建动画
fig <- S_data %>%
  plot_ly(
    lat = ~Lat,
    lon = ~Lon,
    type = "scattermapbox",
    marker = list(color = "fuchsia"),
    # 手动指定所有日期帧，即使部分帧无数据
    frame = ~factor(Date, levels = all_dates)) 

# 配置地图布局
fig <- fig %>%
  layout(
    mapbox= list(
      style = "white-bg",
      sourcetype = 'raster',
      zoom = 4,
      center = list(lon = -112 ,lat= 46.7),
      layers = list(list(
        below = 'traces',
        sourcetype = "raster",
        source = list("https://basemap.nationalmap.gov/arcgis/rest/services/USGSImageryOnly/MapServer/tile/{z}/{y}/{x}"))))) %>%
  # 强制保留所有帧，即使为空
  animation_opts(frame = 1000, redraw = TRUE) %>%
  animation_slider(currentvalue = list(prefix = "日期: "))

fig

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