如何制作受试者项目响应随时间变化的动画？

模拟数据 #

以下是包含受试者（subject）、项目（items）及对错（T/F）响应的模拟数据：

#### 加载工具包 ####
library(tidyverse)
library(gganimate)

#### 创建数据框 ####
set.seed(123)
subject <- factor(rep(1:5,100))
score <- rbinom(n=500,
                size=1,
                prob=.5)
tib <- tibble(subject,
           score) %>% 
  group_by(subject) %>% 
  mutate(item = row_number())
tib

问题描述 #

我想要制作单个或多个受试者响应随项目推进的动画。先绘制静态图观察趋势：

#### 绘制项目响应静态趋势图 ####
tib %>% 
  ggplot(aes(x=item,
             y=score,
             color=subject))+
  geom_point()+
  geom_smooth(se=F)

该静态图能大致呈现趋势，但我需要动画展示响应的实时进展。尝试用gganimate时，无法结合geom_smooth实现动画，仅展示点的动画缺乏有效信息：

#### 尝试点动画（效果不佳） ####
tib %>% 
  ggplot(aes(x=item,
             y=score,
             color=subject))+
  geom_point()+
  transition_manual(item)

之后尝试累积和静态图：

#### 绘制累积和静态图 ####
tib %>% 
  mutate(cum_score = cumsum(score)) %>% 
  ggplot(aes(x=item,
             y=cum_score,
             color=subject))+
  geom_line()

但累积和的动画效果依然不理想：

#### 尝试累积和动画（参数错误） ####
tib %>% 
  mutate(cum_score = cumsum(score)) %>% 
  ggplot(aes(x=item,
             y=cum_score,
             color=subject))+
  geom_line()+
  transition_manual(cum_score)

请问是参数设置有误吗？有没有更好的实现方案？

解决方案 #

1. 累积得分的流畅动画 #

你之前使用transition_manual(cum_score)的参数设置错误——cum_score是连续值，且动画需要按项目序号递进，应使用transition_reveal，它专门用于基于x轴变量的递进式动画，能逐步展示曲线的生成过程：

#### 正确的累积和动画 ####
tib %>% 
  group_by(subject) %>% 
  mutate(cum_score = cumsum(score)) %>% 
  ggplot(aes(x=item, y=cum_score, color=subject)) +
  geom_line(size=1) +
  transition_reveal(item) +  # 按项目序号逐步展开曲线
  labs(title = "受试者累积得分随项目推进", x="项目序号", y="累积正确数") +
  theme_minimal()

2. 带平滑趋势线的动画 #

geom_smooth无法直接在动画中实时计算，需提前为每个受试者的累积数据拟合平滑模型，再基于拟合值制作动画：

#### 预计算累积平滑值 ####
smooth_data <- tib %>%
  group_by(subject) %>%
  mutate(cum_score = cumsum(score)) %>%
  group_modify(function(.x, .y) {
    # 对每个受试者的累积数据拟合loess平滑模型
    model <- loess(cum_score ~ item, data = .x)
    .x$smooth_pred <- predict(model, .x$item)
    return(.x)
  })

#### 绘制带平滑趋势的动画 ####
smooth_data %>%
  ggplot(aes(x=item, color=subject)) +
  geom_point(aes(y=score), alpha=0.5) +  # 单个响应点
  geom_line(aes(y=cum_score), size=1) +  # 累积得分曲线
  geom_line(aes(y=smooth_pred), linetype="dashed", size=1) +  # 平滑趋势线
  transition_reveal(item) +
  labs(title = "受试者响应及累积趋势（当前项目: {frame_along}）", 
       x="项目序号", y="得分/累积正确数") +
  theme_minimal()

3. 单个受试者的聚焦动画 #

若需单独展示某受试者的细节，可添加过滤条件后制作动画：

#### 单个受试者的累积得分动画 ####
tib %>% 
  filter(subject == "1") %>%  # 替换为目标受试者ID
  mutate(cum_score = cumsum(score)) %>%
  ggplot(aes(x=item, y=cum_score)) +
  geom_line(color="#2E86AB", size=1.2) +
  geom_point(aes(y=score), color="#F24C4C", size=2) +
  transition_reveal(item) +
  labs(title = "受试者1的累积得分", x="项目序号", y="累积正确数") +
  theme_minimal()

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