新冠肺炎疫情的发展 —— 使用 R 语言绘制动态图表

新冠肺炎疫情的发展 —— 使用 R 语言绘制动态图表

昨天我介绍了如何使用 R 语言绘制动态图表,今天我们再来练习一下。不如我们就绘制一些动态图表展示这一个多月的新冠肺炎疫情的发展趋势吧!

首先可以从知识星球下载本文所需的数据,两个:

  1. 全国数据.xlsx:包含了 1 月 11 号到昨天的全国和武汉的疫情数据;
  2. 省级数据.xlsx:包含了 1 月 12 号到今天上午的各省疫情数据数据;

动态柱状图

首先我们加载需要的一些 R 包:

1
2
3
4
5
library(gganimate)
library(readxl)
library(tidyr)
library(lubridate)
library(tidyverse)

我想先根据全国数据.xlsx数据绘制一幅动态图表,下面我们把这个数据读进 R 里面然后再整理一下:

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
history <- read_xlsx('全国数据.xlsx') %>% 
rename(
全国确诊 = cn_conNum,
全国死亡 = cn_deathNum,
全国治愈 = cn_cureNum,
全国疑似 = cn_susNum,
武汉确诊 = wuhan_conNum,
武汉死亡 = wuhan_deathNum,
武汉治愈 = wuhan_cureNum
) %>%
gather(2:15, key = "key", value = "value") %>%
dplyr::filter(!str_detect(key, "[a-z]")) %>%
mutate(date = ymd(date),
kind = if_else(str_detect(key, "全国"), 1, 0)) %>%
mutate(
key = factor(key,
levels = rev(c("全国确诊", "全国疑似",
"全国治愈", "全国死亡",
"武汉确诊",
"武汉治愈", "武汉死亡")),
labels = rev(c("全国确诊", "全国疑似",
"全国治愈", "全国死亡",
"武汉确诊",
"武汉治愈", "武汉死亡")))
)

得到的 history 数据框是这样的:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
history
#> # A tibble: 315 x 4
#> date key value kind
#> <date> <fct> <dbl> <dbl>
#> 1 2020-02-24 全国确诊 77779 1
#> 2 2020-02-23 全国确诊 77262 1
#> 3 2020-02-22 全国确诊 76846 1
#> 4 2020-02-21 全国确诊 76392 1
#> 5 2020-02-20 全国确诊 75993 1
#> 6 2020-02-19 全国确诊 74675 1
#> 7 2020-02-18 全国确诊 74279 1
#> 8 2020-02-17 全国确诊 72528 1
#> 9 2020-02-16 全国确诊 70635 1
#> 10 2020-02-15 全国确诊 68584 1
#> # … with 305 more rows

kind 是我特意生成用来指明这个观测值是全国的还是武汉的。由于这里的 value 有缺失值,我们把数据框里面的所有缺失值替换成 0:

1
history[is.na(history)] <- 0

我之前介绍过 ggchicklet 这个包,可以用于绘制圆角的柱形图,下面我们使用 gganimate 包绘制动态柱状图:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
library(ggchicklet)
history %>%
ggplot(aes(x = key, y = value,
fill = factor(kind),
frame = date)) +
geom_chicklet() +
theme_ipsum(base_family = cnfont) +
coord_flip() +
labs(y = "病例数量", x = "",
title = "新冠肺炎动态疫情:{days(frame) + ymd('2020-01-11')}") +
guides(fill = "none") +
scale_fill_manual(
values = c(
"1" = "#18BC9C",
"0" = "#E31A1C"
)
) +
transition_manual(date) -> p
animate(p, res = 400, width = 3000, height = 2000)
anim_save('新冠肺炎发展趋势.gif')

我们昨天还介绍了使用 plotly 绘制动态图表,不过需要注意的是 plotly 里面并没有设计 geom_chicklet 图层,所以这里我们只能使用 geom_col 图层:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
library(plotly)
history %>%
mutate(date = as.character(date)) %>%
rename(日期 = date) %>%
ggplot(aes(x = key, y = value,
fill = factor(kind),
frame = 日期)) +
geom_col(position = "identity") +
theme_ipsum(base_family = cnfont) +
coord_flip() +
labs(y = "病例数量", x = "",
title = "新冠肺炎动态疫情") +
theme(legend.position = "none") +
scale_fill_manual(
values = c(
"1" = "#18BC9C",
"0" = "#E31A1C"
)
) -> p
(ggp <- ggplotly(p, height = 550, width = 800) %>%
animation_opts(frame = 100, easing = "linear", redraw = F))
htmlwidgets::saveWidget(ggp, "ggp.html")

动态地图

新冠肺炎疫情动态地图之前也绘制过好多次了,不过都是使用先绘制静态图然后再使用一些命令行工具合成动态图的方法绘制的,这里我们完全使用 gganmiate 试试。

首先把 省级数据.xlsx 和我们需要的地图数据读入 R 中:

1
2
3
4
5
6
7
library(sf)
prov <- read_xlsx('省级数据.xlsx') %>%
select(省份, 日期, 确诊)
border <- read_sf('chinamap/国界线.shp')
provmap <- read_sf('chinamap/中国省界.shp') %>%
full_join(prov, by = c("NAME" = "省份")) %>%
mutate(日期 = ymd(日期), 确诊 = log(确诊))

本来我是直接使用这个 provmap 绘制地图,结果出现了很多缺失,这个因为 省级数据.xlsx 里面有缺失。这个缺失是这种情况:例如 2020 年 1 月 12 日这天只有几个省有数据,导致我们在绘制这天的地图的时候就只绘制出这几个省,所以有必要进行填充,就是我们得保证每天的数据都有 34 个观测值,为此我采用下面的方法。

首先生成一个 crossing 的数据框,这个数据框就是 $34 \times 45$ 的,45 是日期数,然后再把这个“完备”的数据框和上面的 provmap 进行连接:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
provmap <- provmap %>% 
st_drop_geometry() %>%
right_join(crossing(read_sf('chinamap/中国省界.shp'), 日期 = unique(provmap$日期)), by = c("NAME" = "NAME", "日期" = "日期"))
provmap
#> # A tibble: 1,530 x 4
#> NAME 日期 确诊 geometry
#> <chr> <date> <dbl> <MULTIPOLYGON [m]>
#> 1 上海 2020-01-12 NA (((1523071 4067797, 1525726 4066870…
#> 2 上海 2020-01-13 NA (((1523071 4067797, 1525726 4066870…
#> 3 上海 2020-01-14 NA (((1523071 4067797, 1525726 4066870…
#> 4 上海 2020-01-15 NA (((1523071 4067797, 1525726 4066870…
#> 5 上海 2020-01-16 NA (((1523071 4067797, 1525726 4066870…
#> 6 上海 2020-01-17 NA (((1523071 4067797, 1525726 4066870…
#> 7 上海 2020-01-18 NA (((1523071 4067797, 1525726 4066870…
#> 8 上海 2020-01-19 -Inf (((1523071 4067797, 1525726 4066870…
#> 9 上海 2020-01-20 0 (((1523071 4067797, 1525726 4066870…
#> 10 上海 2020-01-21 0.693 (((1523071 4067797, 1525726 4066870…
#> # … with 1,520 more rows

注意到上面的数据框里面有确诊数量为 NA 和 -Inf 的,NA 是因为本来就缺失,-Inf 则是因为这里的确诊数量已经被我通过 mutate(日期 = ymd(日期), 确诊 = log(确诊)) 操作变成了对数确诊数量,而 log(0) 就是 -Inf,为了绘图的需要我们还是把这些观测值替换成 0 吧(虽然不太合理,因为对数确诊数量为 0 对应的确诊数量应该是 1,这里仅供演示)。

1
provmap$确诊[is.infinite(provmap$确诊)] <- 0

然后就是绘图了:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
ggplot(provmap) + 
geom_sf(aes(fill = 确诊,
frame = 日期,
geometry = geometry),
size = 0.1, color = "white") +
geom_sf(data = border,
size = 0.2, color = "white") +
theme_modern_rc(base_family = cnfont) +
worldtilegrid::theme_enhance_wtg() +
scale_fill_viridis_c(name = "确诊人数(对数)") +
labs(title = "新冠肺炎动态疫情:{days(frame) + ymd('2020-01-11')}") +
transition_manual(日期) -> map

animate(map, res = 400, width = 3000, height = 3075)
anim_save('新冠肺炎确诊病例的省份分布.gif')

好了,通过这个示例练习一下是不是感觉对 gganimate 的使用有所感觉了呢?没有感觉也没事,我们明天直播讲解一下!

知识星球附件链接:https://t.zsxq.com/JaUf6Ae

# R

评论

Your browser is out-of-date!

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

×