所有作品合集传送门： Tidy Tuesday
2018 年合集传送门： 2018
Global Mortality
What do people die from?
在过去的几个世纪里，世界发生了很大的变化–这就是《我们的世界》的数据所显示的。然而，有一件事在这种转变中一直保持不变：我们都必须在某个时候死亡。然而，随着生活水平的提高、医疗保健的进步和生活方式的改变，死亡的原因正在发生变化。
在这篇博客中，我们试图回答 “人们死于什么？”，首先看一下全球死因的数据，然后选择国家层面的例子。
世界各地的主要死因仍有很大差异，因此，也可以选择了一些国家，以突出这种异质性。
本次示例通过一些可视化方式来展示这些信息。
1. 一些环境设置
# 设置为国内镜像, 方便快速安装模块
options("repos" = c(CRAN = "https://mirrors.tuna.tsinghua.edu.cn/CRAN/"))
2. 设置工作路径
wkdir <- '/home/user/R_workdir/TidyTuesday/2018/2018-04-16_Global_Mortality/src-c'
setwd(wkdir)
3. 加载 R 包
library(ggplot2)
library(plyr)
library(RColorBrewer)
library(reshape2)
library(tidyverse)
library(showtext)
# 在 Ubuntu 系统上测试的, 不加这个我画出来的汉字会乱码 ~
showtext_auto()
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 diseases (%)` <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 resalbertry 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 disease (%)` <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 diaalbert (%)` <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] "Albovascular diseaert (%)"
## [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
df_tidy$country_code <- NULL
df_tidy[is.na(df_tidy)] <- 0
# 去除列名中的 % 符号
names(df_tidy) <- str_trim(str_remove_all(names(df_tidy), "[[:punct:]]"))
# 使用 2014 年的数据
df_tidy <-subset(df_tidy, year == 2014)
# 获取一些国家的人口数量, 我是从下面这个网站中摘取的, 仅供学习使用, 数据真实性未考虑
# https://mip.phb123.com/city/renkou/rk.html?ivk_sa=1024609w
popdata <- data.frame(country = c('Egypt', 'Philippines', 'Turkey', 'Italy', 'Vietnam', 'Thailand', 'Germany', 'Iran'),
population = c(103571408, 112508994, 85394576, 60281506, 98737341, 59037513, 83873596, 85753137))
# 通过 country 从原始数据中获取相应子集
df_tidy_sub <- subset(df_tidy, country %in% popdata$country)
# 合并人口数据和原始数据
df_tidy_merge <- merge(df_tidy_sub, popdata, by = "country", all = TRUE)
# 计算每个国家总人口的百分比
df_tidy_merge$percentage <- df_tidy_merge$population / sum(as.numeric(df_tidy_merge$population))
# 计算 X 轴最大值
# cumsum() 用于计算一个数组各行的累加值
df_tidy_merge$xmax <- cumsum(df_tidy_merge$percentage)
# 计算 X 轴最小值
df_tidy_merge$xmin <- df_tidy_merge$xmax - df_tidy_merge$percentage
# 删除最终绘图时不需要的列
df_tidy_merge$percentage<-NULL
df_tidy_merge$population<-NULL
df_tidy_merge$year <- NULL
# # 从宽数据透视到长数据转换
df_plot <- melt(df_tidy_merge, id = c("country", "xmin", "xmax"))
# 计算 Y 轴最大值
df_plot <- ddply(df_plot, .(country), transform, ymax = cumsum(value))
# 计算 Y 轴最小值
df_plot <- ddply(df_plot, .(country), transform, ymin = ymax - value)
# 计算国家标签的位置
df_plot$xtext <- with(df_plot, xmin + (xmax - xmin)/2)
df_plot$ytext <- with(df_plot, ymin + (ymax - ymin)/2)
# 简要查看数据内容
glimpse(df_plot)
## Rows: 256
## Columns: 9
## $ country <chr> "Egypt", "Egypt", "Egypt", "Egypt", "Egypt", "Egypt", "Egypt"…
## $ xmin <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ xmax <dbl> 0.1502869, 0.1502869, 0.1502869, 0.1502869, 0.1502869, 0.1502…
## $ variable <fct> Cardiovascular diseases, Cancers, Respiratory diseases, Albert…
## $ value <dbl> 41.456023694, 9.502723552, 4.404477213, 6.989295409, 2.776476…
## $ ymax <dbl> 41.45602, 50.95875, 55.36322, 62.35252, 65.12900, 69.62695, 7…
## $ ymin <dbl> 0.00000, 41.45602, 50.95875, 55.36322, 62.35252, 65.12900, 69…
## $ xtext <dbl> 0.07514343, 0.07514343, 0.07514343, 0.07514343, 0.07514343, 0…
## $ ytext <dbl> 20.72801, 46.20739, 53.16099, 58.85787, 63.74076, 67.37797, 7…
6. 利用 ggplot2 绘图
# 计算疾病的个数
n.disease = length(unique(df_plot$variable))
# 选择配色调色板 RColorBrewer palette
palette = colorRampPalette(brewer.pal(10, "Paired"))
# PS: 方便讲解, 我这里进行了拆解, 具体使用时可以组合在一起
gg <- ggplot(df_plot, aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax, fill = variable))
# geom_rect() 绘制矩形, 好像这个数据累加起来不是 100% ~
gg <- gg + geom_rect()
# geom_text() 添加文本信息
gg <- gg + geom_text(aes(x = xtext, y = 105, label = country, angle = 0, vjust = -.1))
# scale_fill_manual() 采取的是手动赋值的方法, 也就是直接把颜色序列赋值给它的参数 value
gg <- gg + scale_fill_manual(values = palette(n.disease))
# guides() 设置图例信息, 7 列, 按行排序
gg <- gg + guides(fill = guide_legend(nrow = 7, byrow = TRUE))
# geom_segment() 添加线段
gg <- gg + list(geom_segment(aes(x = xmin, y = ymax, xend = xmax, yend = ymax), size = 0.1),
geom_segment(aes(x = xmax, y = ymin, xend = xmax, yend = ymax), size = 0.1))
gg <- gg + labs(title = "2014年·各个国家死亡人口原因",
subtitle = NULL,
x = NULL,
y = NULL,
caption = "资料来源: Our World in Data · graph by 萤火之森")
# theme_minimal() 去坐标轴边框的最小化主题
gg <- gg + theme_minimal()
# theme() 实现对非数据元素的调整, 对结果进行进一步渲染, 使之更加美观
gg <- gg + theme(
# panel.grid.major 主网格线, 这一步表示删除主要网格线
panel.grid.major = element_blank(),
# panel.grid.minor 次网格线, 这一步表示删除次要网格线
panel.grid.minor = element_blank(),
# panel.border 面板背景 数据上面
panel.border = element_blank(),
# panel.background 面板背景 数据下面
panel.background = element_blank(),
# plot.title 主标题
plot.title = element_text(hjust = 0.1, color = "black", size = 20, face = "bold"),
# plot.caption 说明文字
plot.caption = element_text(hjust = 0.85, vjust = 8),
# legend.position 设置图例位置, "bottom" 表示图例放在最下面
legend.position = "bottom",
# legend.text 设置图例文本格式
legend.text = element_text(size = 8),
# legend.title 设置图例标题
legend.title = element_blank(),
# plot.background 图片背景
plot.background = element_rect(fill = "white"))
7. 保存图片到 PDF 和 PNG
gg
filename = '20180416-C-01'
ggsave(filename = paste0(filename, ".pdf"), width = 10.2, height = 8.8, device = cairo_pdf)
ggsave(filename = paste0(filename, ".png"), width = 10.2, height = 8.8, dpi = 100, device = "png")
8. session-info
sessionInfo()
## R version 4.2.1 (2022-06-23)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Ubuntu 20.04.5 LTS
##
## Matrix products: albert
## 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=C LC_TELEPHONE=C
## [11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] showtext_0.9-5 showtextdb_3.0 sysfonts_0.8.8 forcats_0.5.2
## [5] stringr_1.4.1 dplyr_1.0.10 purrr_0.3.4 readr_2.1.2
## [9] tidyr_1.2.1 tibble_3.1.8 tidyverse_1.3.2 reshape2_1.4.4
## [13] RColorBrewer_1.1-3 plyr_1.8.7 ggplot2_3.3.6
##
## loaded via a namespace (and not attached):
## [1] httr_1.4.4 sass_0.4.2 jsonlite_1.8.0
## [4] modelr_0.1.9 bslib_0.4.0 assertthat_0.2.1
## [7] highr_0.9 googlesheets4_1.0.1 cellranger_1.1.0
## [10] yaml_2.3.5 pillar_1.8.1 backports_1.4.1
## [13] glue_1.6.2 digest_0.6.29 rvest_1.0.3
## [16] colorspace_2.0-3 htmltools_0.5.3 pkgconfig_2.0.3
## [19] broom_1.0.1 haven_2.5.1 scales_1.2.1
## [22] tzdb_0.3.0 googledrive_2.0.0 generics_0.1.3
## [25] farver_2.1.1 ellipsis_0.3.2 cachem_1.0.6
## [28] withr_2.5.0 cli_3.3.0 magrittr_2.0.3
## [31] crayon_1.5.1 readxl_1.4.1 evaluate_0.16
## [34] fs_1.5.2 fansi_1.0.3 xml2_1.3.3
## [37] textshaping_0.3.6 tools_4.2.1 hms_1.1.2
## [40] gargle_1.2.1 lifecycle_1.0.1 munsell_0.5.0
## [43] reprex_2.0.2 compiler_4.2.1 jquerylib_0.1.4
## [46] systemfonts_1.0.4 rlang_1.0.5 grid_4.2.1
## [49] rstudioapi_0.14 labeling_0.4.2 rmarkdown_2.16
## [52] gtable_0.3.1 DBI_1.1.3 R6_2.5.1
## [55] lubridate_1.8.0 knitr_1.40 fastmap_1.1.0
## [58] utf8_1.2.2 ragg_1.2.3 stringi_1.7.8
## [61] Rcpp_1.0.9 vctrs_0.4.1 dbplyr_2.2.1
## [64] tidyselect_1.1.2 xfun_0.32
测试数据
配套数据下载：global_mortality.xlsx
745
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
