如何在gganimate中保留散点同时动态展示回归拟合线？

问题背景 #

你有如下数据框：

df <- data.frame(
  Year = rep(c(2003, 2006, 2009, 2012, 2015, 2018, 2022), 3),
  Average = c(539, 538, 543, 554, 542, 544, 546,
              498, 489, 488, 488, 487, 487, 472,
              508, 501, 507, 500, 493, 495, 481),
  code = rep(c("SE ASIA", "EUR27", "North America"), each = 7)
)

并制作了静态ggplot图：

p <- ggplot(df, aes(x = Year, y = Average, color = code)) +
  geom_point(size = 3) +
  stat_smooth(method = "lm", se = TRUE, linewidth = 0.85, aes(fill = code),alpha = 0.25, show.legend = FALSE) +
  labs(title = "Evolução do Average por Região",
       x = "Ano", y = "Average") +
  theme_minimal() +
  theme(legend.title = element_blank()) 

尝试用transition_time制作动画时，因第一帧仅单个点无法拟合回归线报错：

`geom_smooth()` using formula = 'y ~ x'
Error in `$<-.data.frame`(`*tmp*`, "group", value = "") : 
  replacement has 1 row, data has 0

之后你按code分组预计算了拟合值：

df <- df %>%
  group_by(code) %>%
  mutate(smooth_values = predict(lm(Average ~ Year, data = cur_data())))

但用transition_reveal展示拟合线时，无法保留已出现的散点。

解决方案 #

核心是分开处理散点和拟合线的动画逻辑，确保散点随年份依次出现并保留，拟合线逐步展示（或基于累计数据动态更新）。

方法1：基于累计数据动态计算拟合线（贴合“逐步拟合”逻辑）

这个方法会让拟合线随着每年新增的数据实时更新，同时保留所有已出现的散点：

library(tidyverse)
library(gganimate)

# 生成每个年份的累计数据集：按code分组，保留当前年份及之前的所有数据
df_anim <- df %>%
  group_by(code) %>%
  arrange(Year) %>%
  group_split() %>%
  map_dfr(function(region_data) {
    region_data %>%
      mutate(reveal_year = Year) %>%
      group_by(reveal_year) %>%
      # 补全当前reveal_year之前的所有年份数据
      complete(Year = first(Year):reveal_year) %>%
      fill(Average, .direction = "down") %>%
      ungroup()
  }) %>%
  # 对每个code的每个累计年份，重新计算拟合值
  group_by(code, reveal_year) %>%
  mutate(smooth_values = predict(lm(Average ~ Year, data = cur_data()))) %>%
  ungroup()

# 制作动画
anim <- ggplot(df_anim, aes(x = Year, color = code)) +
  # 绘制所有已出现的散点
  geom_point(aes(y = Average), size = 3) +
  # 绘制基于累计数据的拟合线
  geom_line(aes(y = smooth_values), linewidth = 0.85) +
  labs(title = "Evolução do Average por Região",
       x = "Ano", y = "Average") +
  theme_minimal() +
  theme(legend.title = element_blank()) +
  # 按reveal_year逐步展示，保留所有历史元素
  transition_reveal(reveal_year) +
  # 固定Y轴范围，避免动画过程中坐标轴跳动
  view_follow(fixed_y = TRUE)

# 渲染动画
animate(anim)

方法2：用预计算的完整拟合线，逐步展示并保留散点

如果不需要拟合线随数据更新，只是想逐步展示预计算好的完整拟合线，同时保留散点：

library(tidyverse)
library(gganimate)

# 预计算拟合值（你已完成的步骤）
df <- df %>%
  group_by(code) %>%
  mutate(smooth_values = predict(lm(Average ~ Year, data = cur_data()))) %>%
  ungroup()

# 制作动画
anim <- ggplot(df, aes(x = Year, color = code)) +
  # 散点：用shadow_mark确保已出现的点不消失
  geom_point(aes(y = Average), size = 3) +
  # 拟合线：按code分组，确保每条线独立展示
  geom_line(aes(y = smooth_values, group = code), linewidth = 0.85) +
  labs(title = "Evolução do Average por Região",
       x = "Ano", y = "Average") +
  theme_minimal() +
  theme(legend.title = element_blank()) +
  # 按Year逐步展示元素
  transition_reveal(Year) +
  # 强制保留所有已绘制的散点
  shadow_mark() +
  view_follow(fixed_y = TRUE)

# 渲染动画
animate(anim)

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