bind merge r 和join_[R] 制作梅西和C罗进球数的quot;追赶动画quot;

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

效果如下：

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

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

制作过程分为3个步骤:

处理数据
ggplot2创建图像帧
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 fwindowsFonts(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 %>% sortcnt = 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帧，完成动画毫无压力