欢迎访问 生活随笔!

生活随笔

当前位置: 首页 > 编程资源 > 编程问答 >内容正文

编程问答

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

发布时间:2023/12/10 编程问答 69 豆豆
生活随笔 收集整理的这篇文章主要介绍了 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帧,完成动画毫无压力


    本专栏只生产干货,喜欢请关注数据及可视化​zhuanlan.zhihu.com

    总结

    以上是生活随笔为你收集整理的bind merge r 和join_[R] 制作梅西和C罗进球数的quot;追赶动画quot; - ggplot2 + gifski的全部内容,希望文章能够帮你解决所遇到的问题。

    如果觉得生活随笔网站内容还不错,欢迎将生活随笔推荐给好友。