2020全球新冠累积病例动态赛跑图实践

2020年是注定不凡的一年，在这场突如其来的没有硝烟的疫情战疫中，世界各国人民都在不同程度上付出了很大的代价，我们大中国，众志成城，共度国难才有了今天的局面。然而新冠疫情大半年过去了，这么长时间在世界各国到底呈现怎样的发展趋势呢？先直接上图吧：

 

上面的动态条形赛跑图到底是如何做的呢？接下来，大家就和我一起来来揭秘吧：

---

1 数据下载

        进入新冠世界卫生组织官网 https://covid19.who.int/ ，点击图片右下角的“Download Map Data”，即可下载新冠相关统计数据。

2 数据处理

2.1 导入数据

       由于本文主要分析每个月的累积病例数目，需要知道统计时间，国家，区域代号，因此只抽取第1-4列，和第6列（Cumulative_cases）。

# 加载需要的包
library(stringr)
library(lubridate)
library(reshape2)
# 导入数据
dat <- read.csv("WHO-COVID-19-global-data.csv",stringsAsFactors=FALSE)
# 提取需要的列信息 
sub_dat <- dat[,c(1:4,6)]

2.2 提取每月最后一天累积数据

       从上图表可以看出，下载的数据是每天的统计数据，且时间中含有时区，在图表中不需要展示。因此需要把时区替换，并且提取每月的最后一天的数据进行分析。

# 去除日期中的时区信息
sub_dat$Date_reported <- str_replace(sub_dat$Date_reported,"T00:00:00Z","")

# 提取每个国家每个月最后一天的信息记录
LastDayInMonth <- function(dt)
{
  dt <- (as.character(dt))
  dt <- as.character(as.Date(dt) %m+% months(1))
  dt <- as.Date(ISOdate(as.numeric(substr(dt, 1, 4)),
                        as.numeric(substr(dt, 6, 7)),
                        1) - days(1))
  return(dt)
}

last_date <- unique(LastDayInMonth(sub_dat$Date_reported))
dat_five <- sub_dat[sub_dat$Date_reported %in% as.character(last_date),]  #1-5月份数据
dat_six <- sub_dat[sub_dat$Date_reported=="2020-06-25",]  # 6月份数据
dat_halfyear <- rbind(dat_five,dat_six) # 1-6月份数据

2.3 添加各国国旗

      为了使得数据更加容易阅读，我们接下来在图中添加各个国家的flag，这个flag需要在线的URL， 大家可以去网址：https://www.countryflags.io/   查看，引用方式如下，本文通过R语言直接批量给每个国家添加flag网址。

<img src="https://www.countryflags.io/:country_code/:style/:size.png">
​
## 批量添加各国flag
dat_halfyear$Image_URL <- paste("https://www.countryflags.io/",dat_halfyear$Country_code,"/shiny/64.png",sep="")

​

2.4 转化数据格式

      我们从WHO下载的原始数据是按照日期进行统计的有 24102行8列，现在我们需要把数据按国家为行，月份为列进行统计，最终我们转置后的数据为216行8列，最终格式如下所示：

## 转化数据格式
mat <- dcast(dat_halfyear, Country~Date_reported, value.var='Cumulative_cases') # 把日期转化成独立的列
sub_dat_halfyear <- unique(dat_halfyear[order(dat_halfyear$Country),c("Country","WHO_region","Image_URL")])
last <- cbind(sub_dat_halfyear,mat)  #名称和数据合并
colnames(last)[5:10] <- c("Jan","Feb","Mar","Apr","May","Jun") #重新命名
write.table(last[,c(1:3,5:10)],"nCOV19.xls",sep="\t",quote=FALSE,row.names=FALSE) # 导出数据

3 动图制作

       登入网站https://flourish.studio/ ，注册账登录后选择“Bar chart race”，导入上述数据，即可出图，然后利用gif录屏软件录制这个动画视频保存后即可随意播放，再推荐一个好用的Gif录屏软件：GifCam。