效果如下：

數(shù)據(jù)可視化 - 梅西 vs C羅https://www.zhihu.com/video/1084910827596804096數(shù)據(jù)可視化 - 8大射手進(jìn)球趨勢https://www.zhihu.com/video/1084910854461321216

制作過程分為3個步驟:

處理數(shù)據(jù)

ggplot2創(chuàng)建圖像幀

save_gif逐幀打包生成gif文件

使用的packages:

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

---

數(shù)據(jù)處理

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) }

數(shù)據(jù)處理之前要列出制作動畫的關(guān)鍵點(diǎn)：

• 兩人的point和label要同時(shí)顯示(兩人比賽可能不在同一天)
• 在兩人的label重合的時(shí)候，進(jìn)球數(shù)多的人的label要顯示在上面

因此就需要將兩人的比賽日做union再和兩人的data做merge，將缺失的日期補(bǔ)上，再用cumsum()對進(jìn)球數(shù)做累加

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)) }

然后將兩人的數(shù)據(jù)合并，但考慮上面說的第2點(diǎn)要求，還需要將數(shù)據(jù)排序做調(diào)整：

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

先把value（進(jìn)球數(shù)）做升序排序，再按date（日期）做降序排序

至此數(shù)據(jù)處理完畢

---

ggplot2創(chuàng)建圖像幀

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 = "總進(jìn)球數(shù)對比(2009 ~ 2019年): 梅西 vs 羅納爾多",subtitle = filter(df, date == date_end)$date %>% unique,caption = 'Made by 老白Walt') }

代碼比較多，因?yàn)間gplot2如果不做任何配置，效果是比較差的

其中關(guān)鍵的幾個是geom_path畫線，geom_point畫點(diǎn)，geom_text畫文字

需要說明一下的是geom_text中的兩個參數(shù):

check_overlap: 如果設(shè)定為T(TRUE)，則在文本有重疊的情況下先繪制的會蓋掉后繪制的

vjust: 通過調(diào)整文本的縱向坐標(biāo)，拉開兩個文本的間距，可以盡量避免overlap

另外GIF文件就是將很多張圖片串聯(lián)起來生成動畫，所以這里定義了一個生成ggplot object的函數(shù)，用來將每個比賽日的圖片都生成出來

---

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文件

它的不足之處是生成時(shí)間比較長

---

第二個視頻有一些不一樣的地方，我選取了最近10年進(jìn)球最多的8位球員來做動畫，如果union所有人的date會有近10000項(xiàng)(即10000幀)，對GIF來說就是災(zāi)難

退而求其次，將date都轉(zhuǎn)為week即縮減到384幀，完成動畫毫無壓力

---

本專欄只生產(chǎn)干貨，喜歡請關(guān)注數(shù)據(jù)及可視化?zhuanlan.zhihu.com

總結(jié)

以上是生活随笔為你收集整理的bind merge r 和join_[R] 制作梅西和C罗进球数的quot;追赶动画quot; - ggplot2 + gifski的全部內(nèi)容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網(wǎng)站內(nèi)容還不錯，歡迎將生活随笔推薦給好友。