如何为R绘制的伦敦交通事故时空分布动画添加同步时间轴

核心思路 #

• 先将事故数据按发生时间排序，为每个事故点分配唯一序列ID
• 单独编写时间轴生成函数，传入当前播放的事故ID即可生成对应高亮状态的时间轴
• 每帧生成时将tmap地图和对应时间轴上下拼接
• 使用magick包将拼接后的所有帧渲染为GIF动画

完整修改后代码 #

# 安装缺失包（仅首次运行需要）
install.packages(c("stats19", "sf", "tidyverse", "tmap", "tmaptools", "spData", "lubridate", "patchwork", "magick"))
# 加载依赖
library(stats19)
library(sf)
library(tidyverse)
library(tmap)
library(tmaptools)
library(spData)
library(lubridate)
library(patchwork)
library(magick)

# 英国交通事故数据
crashes_2019 <- get_stats19(year = 2019, type ="accidents")

# 单日交通事故数据
crashes <- crashes_2019 %>%
  drop_na() %>% 
  filter(date == as_date("2019-01-05")) %>%
  st_as_sf(coords = c("longitude", "latitude"), crs = 4326)

# 创建研究区域多边形
my_polygon <- cycle_hire %>%
  slice(1:5) %>%
  st_buffer(dist = 10000) %>%
  st_union()

# 研究区域开放街道地图
bb <- st_bbox(my_polygon)
osm_map <- read_osm(bb)

# 研究区域内的交通事故数据
crashes_zone <- st_intersection(crashes, my_polygon) %>%
  # 拼接完整时间、按时间排序、生成序列ID
  mutate(datetime = ymd_hms(paste(date, time))) %>%
  arrange(datetime) %>%
  mutate(point_id = row_number())

# 提取时间范围用于时间轴刻度
time_range <- range(crashes_zone$datetime)

# 时间轴生成函数
generate_timeline <- function(current_id) {
  ggplot(crashes_zone, aes(x = datetime, y = 0)) +
    # 时间轴基线
    geom_hline(yintercept = 0, linewidth = 1, color = "gray30") +
    # 事故点高亮：当前播放点为红色，其余为灰色
    geom_point(aes(color = point_id == current_id), size = 3) +
    scale_color_manual(values = c("TRUE" = "red", "FALSE" = "gray70")) +
    # 时间刻度格式化
    scale_x_datetime(limits = time_range, date_labels = "%H:%M", date_breaks = "1 hour") +
    # 精简主题
    theme_minimal() +
    theme(
      axis.title = element_blank(),
      axis.text.y = element_blank(),
      axis.ticks.y = element_blank(),
      panel.grid = element_blank(),
      legend.position = "none",
      plot.margin = margin(t = -10, b = 10, l = 20, r = 20)
    )
}

# 生成带时间轴的动画帧
frame_list <- lapply(1:nrow(crashes_zone), function(point_id){
  # 生成单帧地图
  x <- crashes_zone[point_id,]  
  map_plot <- tm_shape(my_polygon) + 
    tm_polygons(alpha = 0.1) + 
    tm_shape(osm_map) + 
    tm_rgb(alpha = 0.6) + 
    tm_shape(x) +
    tm_sf(col = 'red', size = 0.5) +
    tm_layout(legend.show = FALSE)
  # 转tmap为可拼接的grob对象
  map_grob <- tmap_grob(map_plot)
  # 生成对应时间轴
  timeline_plot <- generate_timeline(point_id)
  # 上下拼接：地图占80%高度，时间轴占20%
  combined_plot <- wrap_elements(map_grob) / timeline_plot +
    plot_layout(heights = c(8, 2))
  return(combined_plot)
})

# 渲染输出GIF
gif_graph <- image_graph(width = 300, height = 750, res = 96)
lapply(frame_list, print)
dev.off()
final_gif <- image_animate(gif_graph, fps = 10) # 每秒10帧对应原delay=100ms
image_write(final_gif, "london_crash_timeline.gif")

可调参数说明 #

• 时间轴点大小、颜色：修改generate_timeline中geom_point的size参数、scale_color_manual的色值
• 时间轴刻度间隔：修改scale_x_datetime的date_breaks参数，支持30 min、2 hour等值
• 地图与时间轴占比：修改plot_layout的heights参数
• 动画播放速度：修改image_animate的fps参数，数值越大播放越快

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