R语言ggplotly实现按days分帧的geom_tile与geom_text动画问题

数据框定义 #

dt <- 
data.frame(
        date = as.Date(c("2022-01-01", "2022-01-02", "2022-01-01", "2022-01-02", "2022-01-01", "2022-01-02", "2022-01-01", "2022-01-02")),
        seq = c(1, 1, 2, 2, 1, 1, 2, 2),
        days = c(1, 1, 1, 1, 2, 2, 2, 2),
        val = seq(1, 8))

尝试的代码 #

试图通过ggplotly创建以days为动画帧的geom_tile和geom_text图表，代码如下：

ggplotly(
    ggplot(
      dt,
      aes(x = seq, y = date, fill = days)) +
      geom_tile(frame = days) +
      geom_text(aes(label = val), frame = days) +
      facet_grid(days~.) 
  )

报错信息 #

运行后出现警告，且无动画效果：

Warning messages:
1: Ignoring unknown parameters: frame
2: Ignoring unknown parameters: frame

预期效果 #

动画分为两帧：

• 第一帧展示days=1的数据
• 第二帧展示days=2的数据

问题根源 #

frame不是ggplot图层（如geom_tile、geom_text）的合法参数，ggplot无法识别该参数，因此抛出警告且动画不生效。要实现需求，需采用ggplot2动画工具或plotly原生动画语法。

方法1：使用gganimate结合ggplotly（贴合ggplot语法） #

先通过gganimate创建ggplot动画对象，再转为ggplotly：

library(gganimate)
library(ggplotly)
library(dplyr)

# 创建带动画的ggplot对象
p <- ggplot(dt, aes(x = seq, y = date, fill = days)) +
  geom_tile() +
  geom_text(aes(label = val)) +
  facet_grid(days~.) +
  transition_states(
    states = days, 
    transition_length = 1,  # 切换动画时长
    state_length = 1        # 每帧停留时长
  )

# 转换为ggplotly动画
ggplotly(p)

方法2：plotly原生语法（更灵活的控制） #

直接用plotly构建分帧动画，自定义播放控件：

library(plotly)
library(dplyr)

# 生成每个days对应的动画帧
frames <- lapply(unique(dt$days), function(d) {
  filtered_dt <- dt %>% filter(days == d)
  list(
    data = list(
      # 瓦片图层
      list(
        x = filtered_dt$seq,
        y = filtered_dt$date,
        type = "heatmap",
        z = filtered_dt$days,
        showscale = FALSE
      ),
      # 文本标签图层
      list(
        x = filtered_dt$seq,
        y = filtered_dt$date,
        type = "scatter",
        mode = "text",
        text = filtered_dt$val,
        textposition = "middle center"
      )
    ),
    name = paste("days =", d)
  )
})

# 构建基础图与动画控件
p <- plot_ly() %>%
  # 添加初始帧（days=1）
  add_heatmap(data = dt %>% filter(days == 1), x = ~seq, y = ~date, z = ~days, showscale = FALSE) %>%
  add_text(data = dt %>% filter(days == 1), x = ~seq, y = ~date, text = ~val, textposition = "middle center") %>%
  layout(
    xaxis = list(title = "seq"),
    yaxis = list(title = "date"),
    # 添加播放/暂停按钮
    updatemenus = list(
      list(
        type = "buttons",
        buttons = list(
          list(
            label = "Play",
            method = "animate",
            args = list(list(frame = list(duration = 1000), fromcurrent = TRUE))
          ),
          list(
            label = "Pause",
            method = "animate",
            args = list(list(frame = list(duration = 0), mode = "immediate"))
          )
        )
      )
    ),
    # 添加滑块切换帧
    sliders = list(
      list(
        active = 0,
        steps = lapply(frames, function(f) {
          list(
            label = f$name,
            method = "animate",
            args = list(list(frame = f), list(mode = "immediate"))
          )
        })
      )
    )
  ) %>%
  animation_opts(frame = 1000) %>%
  animation_slider(currentvalue = list(prefix = "days: "))

p

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