bind merge r 和join_[R] 制作梅西和C罗进球数的"追赶动画" - ggplot2 + gifski

效果如下：

数据可视化 - 梅西 vs C罗https://www.zhihu.com/video/1084910827596804096

数据可视化 - 8大射手进球趋势https://www.zhihu.com/video/1084910854461321216

制作过程分为3个步骤:

1. 处理数据
2. ggplot2创建图像帧
3. save_gif逐帧打包生成gif文件

使用的packages:

library(dplyr)
library(ggplot2)
library(ggthemes)
library(gifski)

---

数据处理

gen_df <- function() {
	mdf <- read.csv('messi.csv')
	rdf <- read.csv('ronaldo.csv')
	alldate = c(mdf$date, rdf$date) %>% unique %>% sort %>% data.frame(date = .)
	tf <- function(d, name) {
		merge(d, alldate, all = T) %>%
			{.[is.na(.)] = 0; .$var = name; .} %>%
			dplyr::mutate(value = cumsum(n))
	}
	mdf <- tf(mdf, '梅西')
	rdf <- tf(rdf, 'C罗')

	bind_rows(mdf, rdf) %>%
		dplyr::arrange(desc(value)) %>%
		dplyr::arrange(date)
}

数据处理之前要列出制作动画的关键点：

• 两人的point和label要同时显示(两人比赛可能不在同一天)
• 在两人的label重合的时候，进球数多的人的label要显示在上面

因此就需要将两人的比赛日做union再和两人的data做merge，将缺失的日期补上，再用cumsum()对进球数做累加

alldate = c(mdf$date, rdf$date) %>% unique %>% sort %>% data.frame(date = .)
tf <- function(d, name) {
	merge(d, alldate, all = T) %>%
		{.[is.na(.)] = 0; .$var = name; .} %>%
		dplyr::mutate(value = cumsum(n))
}

然后将两人的数据合并，但考虑上面说的第2点要求，还需要将数据排序做调整：

bind_rows(mdf, rdf) %>%
	dplyr::arrange(desc(value)) %>%
	dplyr::arrange(date)

先把value（进球数）做升序排序，再按date（日期）做降序排序

至此数据处理完毕

---

ggplot2创建图像帧

gen_plt <- function(df, date_end) {
	gdf <- filter(df, date <= date_end)
	f = floor(max(gdf$value) / 100)
	hlines = if (f > 0) seq(100, f * 100, 100) else f
	windowsFonts(myFont = windowsFont("微软雅黑"))
	ggplot(
		data = gdf,
		aes(
			x = date,
			y = value,
			color = var,
			label = paste0(var, '(', value, ')')
		)
	) +
		geom_path() +
		scale_x_date(
			breaks = seq.int(df$date[1], df$date[nrow(df)], '4 months'),
			date_labels = "%Y-%m",
			limits = c(df$date[1], df$date[nrow(df)] + 150)
		) +
		geom_point(
			data = filter(gdf, date == date_end),
			size = 2
		) +
		geom_text(
			data = filter(gdf, date == date_end),
			fontface = 'bold',
			hjust = 0,
			vjust = c(-.2, .2),
			nudge_x = 30,
			size = 3.5,
			check_overlap = T
		) +
		geom_hline(
			yintercept = hlines,
			linetype = 2
		) +
		scale_color_manual(values = c('chocolate', 'blue1')) +
		theme_fivethirtyeight() +
		theme(
			text = element_text(family = 'myFont'),
			axis.text.x = element_text(angle = -30, hjust = 0),
			legend.position = "none",
			plot.title = element_text(face = "bold", color = '#334433'),
			plot.subtitle = element_text(face = "bold", size = 14, color = '#667766'),
			plot.caption = element_text(hjust = 0, size = 10, face = "bold.italic", color = '#556677')
		) +
		labs(
			x = "",
			y = "",
			title = "总进球数对比(2009 ~ 2019年): 梅西 vs 罗纳尔多",
			subtitle = filter(df, date == date_end)$date %>% unique,
			caption = 'Made by 老白Walt'
		)
}

代码比较多，因为ggplot2如果不做任何配置，效果是比较差的

其中关键的几个是geom_path画线，geom_point画点，geom_text画文字

需要说明一下的是geom_text中的两个参数:

check_overlap: 如果设定为T(TRUE)，则在文本有重叠的情况下先绘制的会盖掉后绘制的

vjust: 通过调整文本的纵向坐标，拉开两个文本的间距，可以尽量避免overlap

另外GIF文件就是将很多张图片串联起来生成动画，所以这里定义了一个生成ggplot object的函数，用来将每个比赛日的图片都生成出来

---

save_gif逐帧打包生成gif文件

gen_gif <- function(df, filename, width = 1280, height = 720, res = 144) {
	dates = df$date %>% unique %>% sort
	cnt = length(dates)
	save_gif(
		{
			print('Processing...')
			for (i in 1:cnt) {
				g <- gen_plt(df, dates[i])
				print(paste(i, 'of', cnt))
				print(g)
			}
			for (i in 1:20) {
				print(paste(i, 'of', 20))
				print(g)
			}
		},
		gif_file = filename,
		width = width,
		height = height,
		res = res,
		delay = 0.1
	)
}

df <- gen_df()
gen_gif(df, 'messi_vs_ronaldo.gif')

这里就是遍历date，逐个生成图片：

g <- gen_plt(df, dates[i])

并打印输出到save_gif

print(g)

save_gif会帮你生成最终的gif文件

它的不足之处是生成时间比较长

---

第二个视频有一些不一样的地方，我选取了最近10年进球最多的8位球员来做动画，如果union所有人的date会有近10000项(即10000帧)，对GIF来说就是灾难

退而求其次，将date都转为week即缩减到384帧，完成动画毫无压力

---

本专栏只生产干货，喜欢请关注

数据及可视化​zhuanlan.zhihu.com