1500字范文 > 0416-H · Global Mortality · ggplot2 地图 gganimate 动图动态地图 · R 语言数据可视化案例源码

0416-H · Global Mortality · ggplot2 地图 gganimate 动图动态地图 · R 语言数据可视化案例源码

时间：2018-07-15 15:17:34

所有作品合集传送门： Tidy Tuesday

年合集传送门：

Global Mortality

What do people die from?

在过去的几个世纪里，世界发生了很大的变化–这就是《我们的世界》的数据所显示的。然而，有一件事在这种转变中一直保持不变：我们都必须在某个时候死亡。然而，随着生活水平的提高、医疗保健的进步和生活方式的改变，死亡的原因正在发生变化。

在这篇博客中，我们试图回答 “人们死于什么？”，首先看一下全球死因的数据，然后选择国家层面的例子。

世界各地的主要死因仍有很大差异，因此，也可以选择了一些国家，以突出这种异质性。

本次示例通过一些可视化方式来展示这些信息。

gganimate让你的统计图动起来！动态交互图的绘制在 R 实际工作中应用的比较多，在 R 中我们可以使用 gganimate 包来快速完成一张动态图的绘制。这里我们借助这个 R 包绘制了一个动态地图。

1. 一些环境设置

# 设置为国内镜像, 方便快速安装模块options("repos" = c(CRAN = "https://mirrors.tuna./CRAN/"))

2. 设置工作路径

wkdir <- '/home/user/R_workdir/TidyTuesday//-04-16_Global_Mortality/src-h'setwd(wkdir)

3. 加载 R 包

一些关于字体的设置可以参考这篇文章 R/ggplot2保存图片中文字体至PDF——showtext包一文清除所有障碍。需要更多的相关字体设置知识可以自行学习帮助文档或检索其他文章，这里不多加累述了。

# rnaturalearth 提供了自然地球的简单特征# The rnaturalearthdata package needs to be installed. --> install.packages("rnaturalearthdata")library(tidyverse)library(lubridate)library(rnaturalearth)library(sf)library(gganimate)library(ggtext)# 需要能访问 Google, 也可以注释掉下面这行, 影响不大sysfonts::font_add_google("Gochi Hand", "gochi")

4. 加载数据

# 读取数据df_input <- readxl::read_excel("../data/global_mortality.xlsx")# 简要查看数据内容glimpse(df_input)

## Rows: 6,156## Columns: 35## $ country<chr> "Afghanistan", "Afghanistan…## $ country_code <chr> "AFG", "AFG", "AFG", "AFG",…## $ year <dbl> 1990, 1991, 1992, 1993, 199…## $ `Cardiovascular dalberts (%)` <dbl> 17.61040, 17.80181, 18.3868…## $ `Cancers (%)`<dbl> 4.025975, 4.054145, 4.17395…## $ `Respiratory diseases (%)` <dbl> 2.106626, 2.134176, 2.20829…## $ `Diabetes (%)` <dbl> 3.832555, 3.822228, 3.90012…## $ `Dementia (%)` <dbl> 0.5314287, 0.5324973, 0.540…## $ `Lower respiratory infections (%)` <dbl> 10.886362, 10.356968, 10.09…## $ `Neonatal deaths (%)` <dbl> 9.184653, 8.938897, 8.84138…## $ `Diarrheal diseases (%)` <dbl> 2.497141, 2.572228, 2.70774…## $ `Road accidents (%)` <dbl> 3.715944, 3.729142, 3.81635…## $ `Liver disease (%)` <dbl> 0.8369093, 0.8455159, 0.874…## $ `Tuberculosis (%)`<dbl> 5.877075, 5.891704, 6.03466…## $ `Kidney disease (%)` <dbl> 1.680611, 1.671115, 1.70098…## $ `Digestive diseases (%)` <dbl> 1.058771, 1.049322, 1.06288…## $ `HIV/AIDS (%)` <dbl> 0.01301948, 0.01451458, 0.0…## $ `Suicide (%)`<dbl> 0.4366105, 0.4422802, 0.456…## $ `Malaria (%)`<dbl> 0.4488863, 0.4550191, 0.460…## $ `Homicide (%)` <dbl> 1.287020, 1.290991, 1.32616…## $ `Nutritional deficiencies (%)` <dbl> 0.3505045, 0.3432123, 0.345…## $ `Meningitis (%)` <dbl> 3.037603, 2.903202, 2.84064…## $ `Protein-energy malnutrition (%)`<dbl> 0.3297599, 0.3221711, 0.323…## $ `Drowning (%)` <dbl> 0.9838624, 0.9545860, 0.951…## $ `Maternal deaths (%)` <dbl> 1.769213, 1.749264, 1.76424…## $ `Parkinson ialbert (%)`<dbl> 0.02515859, 0.02545063, 0.0…## $ `Alcohol disorders (%)`<dbl> 0.02899828, 0.02917152, 0.0…## $ `Intestinal infectious diseases (%)` <dbl> 0.1833303, 0.1781074, 0.176…## $ `Drug disorders (%)` <dbl> 0.04120540, 0.04203340, 0.0…## $ `Hepatitis (%)` <dbl> 0.1387378, 0.1350081, 0.134…## $ `Fire (%)` <dbl> 0.1741567, 0.1706712, 0.171…## $ `Heat-related (hot and cold exposure) (%)` <dbl> 0.1378229, 0.1348266, 0.139…## $ `Natural disasters (%)`<dbl> 0.00000000, 0.79760256, 0.3…## $ `Conflict (%)` <dbl> 0.932, 2.044, 2.408, NA, 4.…## $ `Terrorism (%)` <dbl> 0.007, 0.040, 0.027, NA, 0.…

# 检查数据的列名colnames(df_input)

## [1] "country" ## [2] "country_code" ## [3] "year"## [4] "Cardiovascular diseases (%)" ## [5] "Cancers (%)" ## [6] "Respiratory diseases (%)"## [7] "Diabetes (%)" ## [8] "Dementia (%)" ## [9] "Lower respiratory infections (%)" ## [10] "Neonatal deaths (%)" ## [11] "Diarrheal diseases (%)" ## [12] "Road accidents (%)" ## [13] "Liver disease (%)" ## [14] "Tuberculosis (%)" ## [15] "Kidney disease (%)" ## [16] "Digestive diseases (%)" ## [17] "HIV/AIDS (%)" ## [18] "Suicide (%)" ## [19] "Malaria (%)" ## [20] "Homicide (%)" ## [21] "Nutritional deficiencies (%)" ## [22] "Meningitis (%)"## [23] "Protein-energy malnutrition (%)" ## [24] "Drowning (%)" ## [25] "Maternal deaths (%)" ## [26] "Parkinson disease (%)" ## [27] "Alcohol disorders (%)" ## [28] "Intestinal infectious diseases (%)"## [29] "Drug disorders (%)" ## [30] "Hepatitis (%)" ## [31] "Fire (%)" ## [32] "Heat-related (hot and cold exposure) (%)"## [33] "Natural disasters (%)" ## [34] "Conflict (%)" ## [35] "Terrorism (%)"

5. 数据预处理

# 取前一df_tidy <- df_input %>%gather(key = disease, value = mortality, -c(country, country_code, year)) %>%# 建议使用 dplyr::mutate 形式调用函数, 有可能与 plyr 中的函数冲突 (因为我自己就报错了...)dplyr::mutate(disease = substr(disease, 1, nchar(disease) - 4),year = year(as.Date.character(year, format = "%Y"))) %>%group_by(country, year) %>%top_n(1, mortality)# 删除缺失值df_tidy <- na.omit(df_tidy)# 这将是我们的基本世界地图, 不包括南极洲world <- ne_countries(scale = 'medium', type = 'map_units', returnclass = 'sf') %>% filter(!name %in% c("Fr. S. Antarctic Lands", "Antarctica"))# 合并数据df_world <- merge(world, df_tidy, by.x = "name", by.y = "country")# 简要查看数据内容glimpse(df_world)

## Rows: 4,644## Columns: 68## $ name <chr> "Afghanistan", "Afghanistan", "Afghanistan", "Afghanistan…## $ scalerank <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, …## $ featurecla <chr> "Admin-0 map unit", "Admin-0 map unit", "Admin-0 map unit…## $ labelrank <dbl> 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, …## $ sovereignt <chr> "Afghanistan", "Afghanistan", "Afghanistan", "Afghanistan…## $ sov_a3 <chr> "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "…## $ adm0_dif<dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …## $ level <dbl> 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, …## $ type <chr> "Sovereign country", "Sovereign country", "Sovereign coun…## $ admin <chr> "Afghanistan", "Afghanistan", "Afghanistan", "Afghanistan…## $ adm0_a3<chr> "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "…## $ geou_dif<dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …## $ geounit<chr> "Afghanistan", "Afghanistan", "Afghanistan", "Afghanistan…## $ gu_a3 <chr> "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "…## $ su_dif <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …## $ subunit<chr> "Afghanistan", "Afghanistan", "Afghanistan", "Afghanistan…## $ su_a3 <chr> "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "…## $ brk_diff<dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …## $ name_long <chr> "Afghanistan", "Afghanistan", "Afghanistan", "Afghanistan…## $ brk_a3 <chr> "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "…## $ brk_name<chr> "Afghanistan", "Afghanistan", "Afghanistan", "Afghanistan…## $ brk_group <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, N…## $ abbrev <chr> "Afg.", "Afg.", "Afg.", "Afg.", "Afg.", "Afg.", "Afg.", "…## $ postal <chr> "AF", "AF", "AF", "AF", "AF", "AF", "AF", "AF", "AF", "AF…## $ formal_en <chr> "Islamic State of Afghanistan", "Islamic State of Afghani…## $ formal_fr <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, N…## $ note_adm0 <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, N…## $ note_brk<chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, N…## $ name_sort <chr> "Afghanistan", "Afghanistan", "Afghanistan", "Afghanistan…## $ name_alt<chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, N…## $ mapcolor7 <dbl> 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, …## $ mapcolor8 <dbl> 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, …## $ mapcolor9 <dbl> 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, …## $ mapcolor13 <dbl> 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, …## $ pop_est<dbl> 28400000, 28400000, 28400000, 28400000, 28400000, 2840000…## $ gdp_md_est <dbl> 22270, 22270, 22270, 22270, 22270, 22270, 22270, 22270, 2…## $ pop_year<dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, N…## $ lastcensus <dbl> 1979, 1979, 1979, 1979, 1979, 1979, 1979, 1979, 1979, 197…## $ gdp_year<dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, N…## $ economy<chr> "7. Least developed region", "7. Least developed region",…## $ income_grp <chr> "5. Low income", "5. Low income", "5. Low income", "5. Lo…## $ wikipedia <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, N…## $ fips_10<chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, N…## $ iso_a2 <chr> "AF", "AF", "AF", "AF", "AF", "AF", "AF", "AF", "AF", "AF…## $ iso_a3 <chr> "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "…## $ iso_n3 <chr> "004", "004", "004", "004", "004", "004", "004", "004", "…## $ un_a3 <chr> "004", "004", "004", "004", "004", "004", "004", "004", "…## $ wb_a2 <chr> "AF", "AF", "AF", "AF", "AF", "AF", "AF", "AF", "AF", "AF…## $ wb_a3 <chr> "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "…## $ woe_id <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, N…## $ adm0_a3_is <chr> "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "…## $ adm0_a3_us <chr> "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "…## $ adm0_a3_un <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, N…## $ adm0_a3_wb <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, N…## $ continent <chr> "Asia", "Asia", "Asia", "Asia", "Asia", "Asia", "Asia", "…## $ region_un <chr> "Asia", "Asia", "Asia", "Asia", "Asia", "Asia", "Asia", "…## $ subregion <chr> "Southern Asia", "Southern Asia", "Southern Asia", "South…## $ region_wb <chr> "South Asia", "South Asia", "South Asia", "South Asia", "…## $ name_len<dbl> 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 1…## $ long_len<dbl> 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 1…## $ abbrev_len <dbl> 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, …## $ tiny <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, N…## $ homepart<dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, …## $ country_code <chr> "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "…## $ year <dbl> 1996, 1998, , , , , 1997, 1995, , 201…## $ disease<chr> "Cardiovascular diseases", "Cardiovascular diseases", "Ca…## $ mortality <dbl> 20.40614, 19.62352, 23.76755, 23.51810, 24.12453, 26.5172…## $ geometry<MULTIPOLYGON [°]> MULTIPOLYGON (((74.89131 37..., MULTIPOLYGON…

6. 用 ggplot2 绘图

# PS: 方便讲解, 我这里进行了拆解, 具体使用时可以组合在一起gg <- ggplot()# geom_sf() 绘制地图gg <- gg + geom_sf(data = world, colour = "azure4", fill = "grey60", size = .5)gg <- gg + geom_sf(data = df_world, aes(fill = disease, group = interaction(year, disease)))# coord_sf() 用于地图的投影转换gg <- gg + coord_sf(crs = st_crs(world), datum = NA)# scale_fill_discrete() 修改图例顺序, breaks 是原数据, labels 是新的标签, 需要一一对应gg <- gg + scale_fill_discrete(breaks = c('Cardiovascular diseases', 'Diarrheal diseases', 'Neonatal deaths', 'Natural disasters', 'Lower respiratory infections', 'Malaria', 'HIV/AIDS','Cancers', 'Conflict', 'Tuberculosis', 'Nutritional deficiencies'),labels = c('心血管疾病', '痢疾', '新生儿死亡', '自然灾害', '下呼吸道感染', '疟疾', '艾滋病', '癌症', '战争冲突', '肺结核', '营养缺乏'))# transition_states() 在动画中数据的几个不同阶段之间的转换gg <- gg + transition_states(year)gg <- gg + ggthemes::theme_fivethirtyeight()# enter_fade() 淡入gg <- gg + enter_fade()# exit_fade() 淡出gg <- gg + exit_fade()# labs() 对图形添加注释和标签（包含标题、子标题、坐标轴和引用等注释)gg <- gg + labs(title = "大多数人死于什么：{closest_state} 年",subtitle = NULL,x = NULL,y = NULL,caption = "资料来源: Our World in Data · graph by 萤火之森\n")# theme_minimal() 去坐标轴边框的最小化主题gg <- gg + theme_minimal()# theme() 实现对非数据元素的调整, 对结果进行进一步渲染, 使之更加美观gg <- gg + theme(# plot.margin 调整图像边距, 上-右-下-左plot.margin = grid::unit(c(9, 16, 9, 16), "mm"),# aspect.ratio 固定图像的纵横比aspect.ratio = 9/16,# legend.position 设置图例位置, "bottom" 表示图例放置于底端legend.position = "top",# legend.text 设置图例文本格式legend.text = element_text(family = 'gochi', size = 28, margin = margin(r = 12, unit = "pt")),# legend.title 设置图例标题legend.title = element_blank(),# plot.title 主标题plot.title = element_markdown(family = 'gochi', color = "dodgerblue4", hjust = 0.5, size = 48),# plot.caption 说明文字plot.caption = element_markdown(color = "red", size = 16))

7. 保存图片到 PDF 和 PNG

# Error: The gifski package is required to use gifski_renderer --> install.packages('gifski')# Error in transform_sf(all_frames, next_state, ease, params$transition_length[i], : The transformr package is required to tween sf layers --> install.packages('transformr')# 默认 fps = 10, 如果调试的话, 可以设置为 fps = 1, 稍微快那么一点点 ~animate(gg, renderer = gifski_renderer(), fps = 10, width = 1580, height = 1000, duration = length(unique(df_world$year)))

filename = '0416-H-01'anim_save(filename = paste0(filename, ".gif"))

8. session-info

sessionInfo()

## R version 4.2.1 (-06-23)## Platform: x86_64-pc-linux-gnu (64-bit)## Running under: Ubuntu 20.04.5 LTS## ## Matrix products: default## BLAS: /usr/lib/x86_64-linux-gnu/openblas-pthread/libblas.so.3## LAPACK: /usr/lib/x86_64-linux-gnu/openblas-pthread/liblapack.so.3## ## locale:## [1] LC_CTYPE=en_US.UTF-8 LC_NUMERIC=C ## [3] LC_TIME=en_US.UTF-8 LC_COLLATE=en_US.UTF-8 ## [5] LC_MONETARY=en_US.UTF-8 LC_MESSAGES=en_US.UTF-8 ## [7] LC_PAPER=en_US.UTF-8 LC_NAME=C ## [9] LC_ADDRESS=CLC_TELEPHONE=C ## [11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C ## ## attached base packages:## [1] statsgraphics grDevices utilsdatasets methods base## ## other attached packages:## [1] ggtext_0.1.2 gganimate_1.0.8sf_1.0-8 ## [4] rnaturalearth_0.1.0 lubridate_1.8.0forcats_0.5.2## [7] stringr_1.4.1 dplyr_1.0.10 purrr_0.3.4 ## [10] readr_2.1.2 tidyr_1.2.1 tibble_3.1.8 ## [13] ggplot2_3.3.6 tidyverse_1.3.2 ## ## loaded via a namespace (and not attached):## [1] fs_1.5.2progress_1.2.2httr_1.4.4 ## [4] tools_4.2.1 backports_1.4.1 bslib_0.4.0 ## [7] utf8_1.2.2 R6_2.5.1KernSmooth_2.23-20## [10] DBI_1.1.3colorspace_2.0-3 withr_2.5.0 ## [13] sp_1.5-0tidyselect_1.1.2 rnaturalearthdata_0.1.0## [16] prettyunits_1.1.1 curl_4.3.2 compiler_4.2.1 ## [19] cli_3.3.0rvest_1.0.3 xml2_1.3.3 ## [22] sass_0.4.2 scales_1.2.1 classInt_0.4-8 ## [25] proxy_0.4-27 digest_0.6.29 rmarkdown_2.16 ## [28] pkgconfig_2.0.3 htmltools_0.5.3 highr_0.9 ## [31] dbplyr_2.2.1 fastmap_1.1.0 rlang_1.0.5 ## [34] ggthemes_4.2.4readxl_1.4.1 rstudioapi_0.14 ## [37] sysfonts_0.8.8jquerylib_0.1.4 farver_2.1.1 ## [40] generics_0.1.3jsonlite_1.8.0googlesheets4_1.0.1 ## [43] magrittr_2.0.3s2_1.1.0Rcpp_1.0.9 ## [46] munsell_0.5.0 fansi_1.0.3 lifecycle_1.0.1 ## [49] stringi_1.7.8 yaml_2.3.5 grid_4.2.1 ## [52] crayon_1.5.1 lattice_0.20-45 haven_2.5.1 ## [55] gridtext_0.1.5hms_1.1.2transformr_0.1.4 ## [58] knitr_1.40 pillar_1.8.1 markdown_1.1 ## [61] lpSolve_5.6.16wk_0.6.0reprex_2.0.2 ## [64] glue_1.6.2 evaluate_0.16 gifski_1.6.6-1 ## [67] modelr_0.1.9 vctrs_0.4.1 tzdb_0.3.0 ## [70] tweenr_2.0.2 cellranger_1.1.0 gtable_0.3.1 ## [73] assertthat_0.2.1 cachem_1.0.6 xfun_0.32 ## [76] broom_1.0.1 e1071_1.7-11 class_7.3-20 ## [79] googledrive_2.0.0 gargle_1.2.1 units_0.8-0 ## [82] ellipsis_0.3.2