如何构建像Hans-Rosling那样的动画图表——在R中完成所有操作

如何构建像Hans-Rosling那样的动画图表——在R中完成所有操作

最近发现走进数据科学这个网站非常不错,建议注册订阅。
这篇文章是How to build Animated Charts like Hans Rosling — doing it all in R的学习笔记。此外本文还介绍了解决R读取xlsx文件过于缓慢的解决办法(使用一个Python编写的命令xlsx2csv)。

汉斯·罗斯林是一位统计学大师,致力于倡导动画图表的使用。

本文展示了两种使用R构建动画图表的方法:

  1. R+gganimate包创建一个GIF文件;
  2. R+plotly

首先我们需要三个数据集:

  1. 出生时预期寿命.xlsx
  2. 人口总数.xlsx
  3. 生育率.xlsx

三个数据都是1800年-2015年各国面板数据。

清理并合并数据

读入数据:

1
2
3
4
library(xlsx)
population <- read.xlsx("人口总数.xlsx", encoding = 'UTF-8', stringAsFactors = F, sheetIndex = 1, as.data.frame = T, header = T)
fertility <- read.xlsx('生育率.xlsx', encoding = 'UTF-8', stringAsFactors = F, sheetIndex = 1, as.data.frame = T, header = T)
life_expectancy_at_birth <- read.xlsx('出生时预期寿命.xlsx', encoding = 'UTF-8', stringAsFactors = F, sheetIndex = 1, as.data.frame = T, header = T)

不过事实上xlsx文件的读取是非常慢的,把xlsx文件转换成csv文件后再读入就会快很多。常见的转换方法是打开然后另存为csv文件,但是你不觉得打开也很慢么?所以我刚刚找了个命令行工具,xlsx2csv,可以非常快速的把xlsx文件转成csv,该工具的GitHub地址为:dilshod/xlsx2csv安装:

1
pip install xlsx2csv

使用

1
2
cd ~/Desktop/R绘制动画图表
xlsx2csv 生育率.xlsx > 生育率.csv

我的这篇博客(几种编程语言中调用shell命令方法汇总)中总结了一些编程语言中调用shell命令的方法,所以可以直接在R脚本里使用shell命令:

1
system('xlsx2csv 生育率.xlsx > 生育率.csv')

所以使用下面的语句读入数据就会非常非常快:

1
2
3
4
5
6
system('/Users/mr.cheng/anaconda3/bin/xlsx2csv 生育率.xlsx > 生育率.csv')
system('/Users/mr.cheng/anaconda3/bin/xlsx2csv 人口总数.xlsx > 人口总数.csv')
system('/Users/mr.cheng/anaconda3/bin/xlsx2csv 出生时预期寿命.xlsx > 出生时预期寿命.csv')
population <- read.csv('人口总数.csv')
fertility <- read.csv('生育率.csv')
life_expectancy_at_birth <- read.csv('出生时预期寿命.csv')

清理合并:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
library(reshape)
library(gapminder)
library(dplyr)
library(ggplot2)

# 创建一个变量,只保留1962-2015年的
(myvars <- paste('X', 1962:2015, sep = ""))

# 创建三个数据集1962-2015的切片
population <- population[c('Total.population', myvars)]
fertility <- fertility[c('Total.fertility.rate', myvars)]
lifeexp <- life_expectancy_at_birth[c('Life.expectancy', myvars)]

# 将第一列重命名为‘Country’
colnames(population)[1] <- 'Country'
colnames(fertility)[1] <- 'Country'
colnames(lifeexp)[1] <- 'Country'

# 只保留前275行(后面多数为空行)
lifeexp <- lifeexp[1:275, ]
population <- population[1:275, ]

# 把宽面板变成长面板
population_m <- melt(population, id = 'Country')
fertility_m <- melt(fertility, id = 'Country')
lifeexp_m <- melt(lifeexp, id = 'Country')

# 变量重命名(为了后面将三个数据库拼接)
colnames(population_m)[3] <- "pop"
colnames(lifeexp_m)[3] <- "life"
colnames(fertility_m)[3] <- "fert"

# 横向合并三个数据框
mydf <- merge(lifeexp_m, fertility_m, by = c("Country", "variable"), header = T)
mydf <- merge(mydf, population_m, by = c("Country", "variable"), header = T)

# 下面需要生成每个国家所属的洲变量,这里需要用到gapminder包
# gapminder 是一个含有country、continent 、year、lifeExp、pop、gdpPercap变量的数据集
(continent <- gapminder %>% group_by(continent, country) %>% distinct(country, continent))
colnames(continent)[1] <- 'Country'
# 找出那些位于某个大洲的国家
mydf_filter <- mydf %>% filter(Country %in% unique(continent$Country))

# 为这个过滤后的数据框添加大洲变量
mydf_filter <- merge(mydf_filter, continent, by = 'Country', header = T)

# 再做一些额外的清理
mydf_filter[is.na(mydf_filter)] <- 0
mydf_filter <- data.frame(lapply(mydf_filter, as.character), stringAsFactors = F)
# 把年份前面的X换成空,再变成数值型
mydf_filter$variable <- as.numeric(as.character(gsub("X", "", mydf_filter$variable)))
# 人口的单位变成百万,保留一位有效数字
mydf_filter$pop <- round(as.numeric(as.character(mydf_filter$pop))/1000000, 1)
mydf_filter$fert <- as.numeric(as.character(mydf_filter$fert))
mydf_filter$life <- as.numeric(as.character(mydf_filter$life))

数据清理完成!

使用gganimate构建图表并生成GIF文件

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
library(ggplot2)
library(gganimate)
library(ggpomological)
p <- ggplot(mydf_filter, aes(fert, life, size = pop, color = continent, frame = variable)) +
geom_point() +
ylim(30, 100) +
labs(title = '年份: {frame + 1961}', x = "生育率", y = "出生时预期寿命(年)", caption = "数据来源:gapminder.com", color = "大洲", size = "人口(百万)") +
scale_color_pomological() +
theme_pomological(base_size = 20, base_family = "MLingWaiMedium-SC") +
transition_manual(variable) +
shadow_mark(exclude_layer = 1)
# 下面两句功能一样
print(p)
animate(p)
anim_save('animate.gif')

使用plotly生成HTML文件

1
2
3
4
5
6
7
8
library(plotly)
p <- ggplot(mydf_filter, aes(fert, life, size = pop, color = continent, frame = variable)) +
geom_point() +
ylim(30, 100) +
labs(x = "生育率", y = "出生时预期寿命", color = "大洲", size = "人口(百万)") +
scale_color_pomological() +
theme_pomological(base_size = 20, base_family = "MLingWaiMedium-SC")
p

然后就可以用p生成html文件了:

1
2
(ggp <- ggplotly(p, height = 400, width = 600) %>%
animation_opts(frame = 100, easing = "linear", redraw = F))

最后再创建一个html文件:

1
htmlwidgets::saveWidget(ggp, "ggp.html")

# R

评论

程振兴

程振兴 @czxa.top
截止今天,我已经在本博客上写了607.9k个字了!

Your browser is out-of-date!

Update your browser to view this website correctly. Update my browser now

×