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

年合集传送门：

Global Mortality

What do people die from?

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

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

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

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

1. 一些环境设置

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

2. 设置工作路径

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

3. 加载 R 包

library(sf)library(tidyverse)library(maptools)library(cartogram)library(patchwork)library(showtext)

# 在 Ubuntu 系统上测试的, 不加这个我画出来的汉字会乱码 ~showtext_auto()

4. 加载数据

# janitor::clean_names() 清理对象(通常是data.frame)的名称df_input <- readxl::read_excel("../data/global_mortality.xlsx") %>% janitor::clean_names()# 获得一些国家和地区的边界数据data("wrld_simpl")# 简要查看数据内容glimpse(df_input)

## Rows: 6,156## Columns: 35## $ country<chr> "Afghanistan", "Afghaalbert…## $ country_code <chr> "AFG", "AFG", "AFG", "AFG",…## $ year <dbl> 1990, 1991, 1992, 1993, 199…## $ cardiovascular_diseases_percent <dbl> 17.61040, 17.80181, 18.3868…## $ cancers_percent <dbl> 4.025975, 4.054145, 4.17395…## $ respiratory_diseases_percent<dbl> 2.106626, 2.134176, 2.20829…## $ diabetes_percent <dbl> 3.832555, 3.822228, 3.90012…## $ dementia_percent <dbl> 0.5314287, 0.5324973, 0.540…## $ lower_respiratory_infections_percent <dbl> 10.886362, 10.356968, 10.09…## $ neonatal_deaths_percent<dbl> 9.184653, 8.938897, 8.84138…## $ diarrheal_diseases_percent <dbl> 2.497141, 2.572228, 2.70774…## $ road_accidents_percent <dbl> 3.715944, 3.729142, 3.81635…## $ liver_disease_percent <dbl> 0.8369093, 0.8455159, 0.874…## $ tuberculosis_percent <dbl> 5.877075, 5.891704, 6.03466…## $ kidney_disease_percent <dbl> 1.680611, 1.671115, 1.70098…## $ digestive_diseases_percent <dbl> 1.058771, 1.049322, 1.06288…## $ hiv_aids_percent <dbl> 0.01301948, 0.01451458, 0.0…## $ suicide_percent <dbl> 0.4366105, 0.4422802, 0.456…## $ malaria_percent <dbl> 0.4488863, 0.4550191, 0.460…## $ homicide_percent <dbl> 1.287020, 1.290991, 1.32616…## $ nutritional_deficiencies_percent <dbl> 0.3505045, 0.3432123, 0.345…## $ meningitis_percent<dbl> 3.037603, 2.903202, 2.84064…## $ protein_energy_malnutrition_percent <dbl> 0.3297599, 0.3221711, 0.323…## $ drowning_percent <dbl> 0.9838624, 0.9545860, 0.951…## $ maternal_deaths_percent<dbl> 1.769213, 1.749264, 1.76424…## $ parkinson_disease_percent <dbl> 0.02515859, 0.02545063, 0.0…## $ alcohol_disorders_percent <dbl> 0.02899828, 0.02917152, 0.0…## $ intestinal_infectious_diseases_percent<dbl> 0.1833303, 0.1781074, 0.176…## $ drug_disorders_percent <dbl> 0.04120540, 0.04203340, 0.0…## $ hepatitis_percent<dbl> 0.1387378, 0.1350081, 0.134…## $ fire_percent <dbl> 0.1741567, 0.1706712, 0.171…## $ heat_related_hot_and_cold_exposure_albertt <dbl> 0.1378229, 0.1348266, 0.139…## $ natural_disasters_percent <dbl> 0.00000000, 0.79760256, 0.3…## $ conflict_percent <dbl> 0.932, 2.044, 2.408, NA, 4.…## $ terrorism_percent<dbl> 0.007, 0.040, 0.027, NA, 0.…

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

## [1] "country"## [2] "country_code"## [3] "year" ## [4] "cardiovascular_diseases_percent" ## [5] "cancers_percent" ## [6] "respiratory_diseases_percent" ## [7] "diabetes_percent"## [8] "dementia_percent"## [9] "lower_respiratory_infections_percent"## [10] "neonatal_deaths_percent" ## [11] "diarrheal_diseases_percent"## [12] "road_accidents_percent"## [13] "liver_disease_percent" ## [14] "tuberculosis_percent" ## [15] "kidney_disease_percent"## [16] "digestive_diseases_percent"## [17] "hiv_aids_percent"## [18] "suicide_percent" ## [19] "malaria_percent" ## [20] "homicide_percent"## [21] "nutritional_deficiencies_percent"## [22] "meningitis_percent" ## [23] "protein_energy_malnutrition_percent" ## [24] "drowning_percent"## [25] "maternal_deaths_percent" ## [26] "parkinson_disease_percent" ## [27] "alcohol_disorders_percent" ## [28] "intestinal_infectious_diseases_palbertt" ## [29] "drug_disorders_percent"## [30] "hepatitis_percent"## [31] "fire_percent"## [32] "heat_related_hot_and_cold_exposure_percent"## [33] "natural_disasters_percent" ## [34] "conflict_percent"## [35] "terrorism_percent"

5. 预设绘图主题

library(ggplot2)Sifo = sessionInfo()if (Sifo$R.version$os == 'linux-gnu') {base <- NULL} else {if ("extrafont" %in% rownames(installed.packages())) {library(extrafont)extrafont::loadfonts(device = "win", quiet = TRUE)base <- "Poppins"} else {base <- "Gadugi" }}theme_custom <- function (base_size = 12, base_family = base){half_line <- base_size/2theme(line = element_line(colour = "grey85", size = 0.4, linetype = 1, lineend = "butt"), rect = element_rect(fill = "grey20", colour = "grey85", size = 0.4, linetype = 1), text = element_text(family = base_family, face = "plain", colour = "white", size = base_size, lineheight = 0.9, hjust = 0.5, vjust = 0.5, angle = 0, margin = margin(), debug = FALSE), axis.line = element_blank(), axis.line.x = NULL, axis.line.y = NULL, axis.text = element_text(size = base_size * 1.1, colour = "grey85"), axis.text.x = element_text(margin = margin(t = 0.8 * half_line/2), vjust = 1), axis.text.x.top = element_text(margin = margin(b = 0.8 * half_line/2), vjust = 0), axis.text.y = element_text(margin = margin(r = 0.8 * half_line/2), hjust = 1), axis.text.y.right = element_text(margin = margin(l = 0.8 * half_line/2), hjust = 0), axis.ticks = element_line(colour = "grey85", size = 0.3), axis.ticks.length = unit(half_line/2, "pt"), axis.ticks.length.x = NULL, axis.ticks.length.x.top = NULL, axis.ticks.length.x.bottom = NULL, axis.ticks.length.y = NULL, axis.ticks.length.y.left = NULL, axis.ticks.length.y.right = NULL, axis.title.x = element_text(margin = unit(c(3.5, 0, 0, 0), "mm"), vjust = 1, size = base_size * 1.3, face = "bold"), axis.title.x.top = element_text(margin = margin(b = half_line), vjust = 0), axis.title.y = element_text(angle = 90, margin = unit(c(0, 3.5, 0, 0), "mm"), vjust = 1, size = base_size * 1.3, face = "bold"), axis.title.y.right = element_text(angle = -90, margin = margin(l = half_line), vjust = 0), legend.background = element_rect(colour = NA), legend.spacing = unit(0.4, "cm"), legend.spacing.x = NULL, legend.spacing.y = NULL, legend.margin = margin(0.2, 0.2, 0.2, 0.2, "cm"), legend.key = element_rect(fill = "grey20", colour = "grey20"), legend.key.size = unit(1.2, "lines"), legend.key.height = NULL, legend.key.width = NULL, legend.text = element_text(size = rel(0.9)), legend.text.align = NULL, legend.title = element_text(hjust = 0, size = rel(1)), legend.title.align = NULL, legend.position = "right", legend.direction = NULL, legend.justification = "center", legend.box = NULL, legend.box.margin = margin(0, 0, 0, 0, "cm"), legend.box.background = element_blank(), legend.box.spacing = unit(0.4, "cm"), panel.background = element_rect(fill = NA, colour = NA), panel.border = element_rect(colour = "grey85", fill = NA, size = rel(1)),panel.grid = element_blank(),panel.grid.major = element_line(colour = "transparent"), panel.grid.minor = element_line(colour = "transparent"), panel.spacing = unit(base_size/2, "pt"), panel.spacing.x = NULL, panel.spacing.y = NULL, panel.ontop = FALSE, strip.background = element_rect(fill = "grey20", colour = "grey85"), strip.text = element_text(colour = "white", size = base_size * 1.1, face = "bold"), strip.text.x = element_text(margin = margin(t = half_line, b = half_line)), strip.text.y = element_text(angle = -90, margin = margin(l = half_line, r = half_line)), strip.placement = "inside", strip.placement.x = NULL, strip.placement.y = NULL, strip.switch.pad.grid = unit(0.1, "cm"), strip.switch.pad.wrap = unit(0.1, "cm"), plot.background = element_rect(colour = NA), plot.title = element_text(size = base_size * 1.8, hjust = 0, vjust = 1, face = "bold", margin = margin(b = half_line * 1.2)), plot.subtitle = element_text(size = base_size, hjust = 0, vjust = 1, margin = margin(b = half_line * 0.9)), plot.caption = element_text(size = rel(0.9), hjust = 1, vjust = 1, margin = margin(t = half_line * 0.9), color = "white"), plot.margin = margin(base_size, base_size, base_size, base_size), complete = T,plot.tag = element_text(size = rel(1.5), face = "bold", hjust = 0.5, vjust = 0.5), plot.tag.position = "topleft")}# theme_set() 来修改默认主题的效果, theme_set(theme_grey()) 还原默认背景, 浅灰色背景和白色网格线, 无边框theme_set(theme_custom())# 更新本次绘图需要的主题theme_update(axis.ticks = element_blank(),axis.text = element_blank(),panel.grid.major = element_blank(),panel.grid.minor = element_blank(),panel.border = element_rect(color = NA),plot.title = element_text(size = 32, hjust = 0.5),plot.subtitle = element_text(color = "grey80", size = 20, face = "bold", hjust = 0.5, margin = margin(b = 6)),plot.caption = element_text(color = "grey60", size = 16, hjust = 0.5, lineheight = 1.2),legend.position = "bottom",legend.title = element_text(color = "grey60", face = "bold", size = 14),legend.text = element_text(color = "grey60", size = 12))

6. Global Mortality

6.1 数据预处理

# 整合地理信息和死亡率数据sf_mortality <-wrld_simpl %>%# st_as_sf() 将 st 格式数据 转换成 sf 格式数据st_as_sf() %>%# st_transform() 坐标系统转换st_transform(crs = "+proj=robin") %>% # 建议使用 dplyr::mutate 形式调用函数, 不然容易与 plyr 中的函数冲突 (因为我自己就报错了...)dplyr::mutate(country_code = as.character(ISO3)) %>%# 合并 Global Mortality 数据left_join(df_input) %>%# 选择 年的数据filter(year == )# 至少一个国家的病因超过 25%df_input %>%gather(cause, percent, -country, -country_code, -year) %>%filter(percent >= 25) %>%distinct(cause)# 计算变形数据# 下面的步骤需要很长时间来计算, 可能需要几十分钟, 甚至一个小时if (!file.exists(paste0(wkdir, "/carto-data/carto_cvd.Rds"))) {carto_cvd <-sf_mortality %>%cartogram_cont("cardiovascular_diseases_percent", itermax = 150)carto_cancer <-sf_mortality %>%cartogram_cont("cancers_percent", itermax = 150)carto_diabetes <-sf_mortality %>%cartogram_cont("diabetes_percent", itermax = 150)carto_hiv <-sf_mortality %>%cartogram_cont("hiv_aids_percent", itermax = 150)carto_malaria <-sf_mortality %>%mutate(malaria_percent = if_else(malaria_percent == 0, 0.01, malaria_percent)) %>%cartogram_cont("malaria_percent", itermax = 150)carto_conflict <-sf_mortality %>%mutate(conflict_percent = if_else(conflict_percent == 0, 0.001, conflict_percent)) %>%cartogram_cont("conflict_percent", itermax = 150)saveRDS(carto_cvd,"carto-data/carto_cvd.Rds")saveRDS(carto_cancer, "carto-data/carto_cancer.Rds")saveRDS(carto_diabetes, "carto-data/carto_diabetes.Rds")saveRDS(carto_hiv,"carto-data/carto_hiv.Rds")saveRDS(carto_malaria, "carto-data/carto_malaria.Rds")saveRDS(carto_conflict, "carto-data/carto_conflict.Rds")} else {# 加载已有数据, 不用反复运行分析程序carto_cvd<- readRDS("carto-data/carto_cvd.Rds")carto_cancer <- readRDS("carto-data/carto_cancer.Rds")carto_diabetes <- readRDS("carto-data/carto_diabetes.Rds")carto_hiv<- readRDS("carto-data/carto_hiv.Rds")carto_malaria <- readRDS("carto-data/carto_malaria.Rds")carto_conflict <- readRDS("carto-data/carto_conflict.Rds")}

6.2 利用 ggplot2 绘图

# PS: 方便讲解, 我这里进行了拆解, 具体使用时可以组合在一起map.base <- ggplot()map.base <- map.base + rcartocolor::scale_fill_carto_c(palette = "BluYl", direction = -1, guide = 'none', limits = c(0, 65.2))# scale_x_continuous() 对连续变量设置坐标轴显示范围map.base <- map.base + scale_x_continuous(breaks = c())# scale_y_continuous() 对连续变量设置坐标轴显示范围map.base <- map.base + scale_y_continuous(breaks = c())# 心血管疾病 Cardiovascular Diseases# geom_sf() 绘制地图map.cdv <- map.base + geom_sf(data = carto_cvd, aes(geometry = geometry, fill = cardiovascular_diseases_percent),color = "transparent", size = 0.1)map.cdv <- map.cdv + labs(subtitle = "心血管疾病")# 癌症 Cancersmap.cancer <- map.base + geom_sf(data = carto_cancer,aes(geometry = geometry, fill = cancers_percent),color = "transparent",size = 0.1) map.cancer <- map.cancer + labs(title = "\n大多数人死于什么？\n\n",subtitle = "癌症",caption = "\n\n世界各地的主要死亡原因仍有很大差异.\n这些地图显示， 年至少有一个国家的死亡原因超过总死亡人数的 20%.\n\n")# 糖尿病 Diabetesmap.diabetes <- map.base + geom_sf(data = carto_diabetes,aes(geometry = geometry, fill = diabetes_percent),color = "transparent",size = 0.1)map.diabetes <- map.diabetes + labs(subtitle = "糖尿病")# 艾滋病 HIV Infections & Aidsmap.hiv <- map.base + geom_sf(data = carto_hiv,aes(geometry = geometry, fill = hiv_aids_percent),color = "transparent", size = 0.1)map.hiv <- map.hiv + labs(subtitle = "艾滋病")# 疟疾 Malariamap.malaria <- ggplot(carto_malaria)map.malaria <- map.malaria + geom_sf(aes(geometry = geometry, fill = malaria_percent),color = "transparent",size = 0.1)map.malaria <- map.malaria + rcartocolor::scale_fill_carto_c(palette = "BluYl",direction = -1,name = "\n\n死亡率",breaks = seq(0, 65, by = 5),labels = glue::glue("{seq(0, 65, by = 5)}%"))map.malaria <- map.malaria + guides(fill = guide_colorbar(barheight = unit(2.3, units = "mm"), barwidth = unit(230, units = "mm"),direction = "horizontal",ticks.colour = "grey20",title.position = "top",label.position = "top",title.hjust = 0.5))map.malaria <- map.malaria + labs(subtitle = "疟疾",caption = "这些数据涉及到具体的死亡原因，并与空气污染、饮食和其他生活方式因素等死亡风险因素区分开来.\n\n\n\n资料来源: Our World in Data · graph by 萤火之森\n") map.malaria <- map.malaria + theme(# plot.caption 说明文字plot.caption = element_text(size = 14))# 战争 & 冲突 War & Conflictsmap.conflict <- map.base + geom_sf(data = carto_conflict, aes(geometry = geometry, fill = conflict_percent),color = "transparent", size = 0.1)map.conflict <- map.conflict + labs(subtitle = "战争 & 冲突")

6.3 保存图片到 PDF 和 PNG

map.cdv + map.cancer + map.diabetes + map.hiv + map.malaria + map.conflict + plot_layout(ncol = 3)

filename = '0416-G-01'ggsave(filename = paste0(filename, ".pdf"), width = 18, height = 12.5, device = cairo_pdf)ggsave(filename = paste0(filename, ".png"), width = 18, height = 12.5, dpi = 100, device = "png")

7. Alcohol & Drugs

7.1 数据预处理

# 计算变形数据# 下面的步骤需要很长时间来计算if (!file.exists(paste0(wkdir, "/carto-data/carto_alcohol.Rds"))) {carto_alcohol <-sf_mortality %>%cartogram_cont("alcohol_disorders_percent", itermax = 250)carto_drugs <-sf_mortality %>%cartogram_cont("drug_disorders_percent", itermax = 250)saveRDS(carto_alcohol, "carto-data/carto_alcohol.Rds")readRDS(carto_drugs, "carto-data/carto_drugs.Rds")} else {# 加载已有数据, 不用反复运行分析程序carto_alcohol <- readRDS("carto-data/carto_alcohol.Rds")carto_drugs <- readRDS("carto-data/carto_drugs.Rds")}

7.2 利用 ggplot2 绘图

# PS: 方便讲解, 我这里进行了拆解, 具体使用时可以组合在一起map.alcohol <- ggplot(carto_alcohol) + geom_sf(aes(geometry = geometry, fill = alcohol_disorders_percent),color = "transparent", size = 0.1)map.alcohol <- map.alcohol + rcartocolor::scale_fill_carto_c(palette = "Peach",limits = c(0, 2.5),breaks = seq(0, 2.5, by = 0.5),labels = c("0.0%", "0.5%", "1.0%", "1.5%", "2.0%", "2.5%"),name = "\n死亡率")map.alcohol <- map.alcohol + guides(fill = guide_colorbar(barheight = unit(2.3, units = "mm"), barwidth = unit(230, units = "mm"),direction = "horizontal",ticks.colour = "grey20",title.position = "top",label.position = "top",title.hjust = 0.5))map.alcohol <- map.alcohol + labs(title = "\n, 约有1.64亿人死于酒精或药物滥用\n\n",subtitle = "酒精滥用",caption = "这些数据涉及到具体的死亡原因, 并与空气污染、饮食和其他生活方式因素等死亡风险因素区分开来.\n\n")map.alcohol <- map.alcohol + theme(# plot.title 主标题plot.title = element_text(size = 22, lineheight = 1.1, face = "plain"),# plot.subtitle 次要标题plot.subtitle = element_text(size = 18),# plot.caption 说明文字plot.caption = element_text(size = 14),# legend.title 设置图例标题legend.title = element_text(size = 16))map.drugs <- ggplot(carto_drugs) + geom_sf(aes(geometry = geometry, fill = drug_disorders_percent),color = "transparent",size = 0.1)map.drugs <- map.drugs + rcartocolor::scale_fill_carto_c(palette = "Peach", limits = c(0, 2.5), guide = "none")map.drugs <- map.drugs + labs(subtitle = "药物滥用",caption = "\n\n\n资料来源: Our World in Data · graph by 萤火之森\n")map.drugs <- map.drugs + theme(# plot.subtitle 次要标题plot.subtitle = element_text(size = 18),# plot.caption 说明文字plot.caption = element_text(size = 14))

7.3 保存图片到 PDF 和 PNG

map.alcohol / map.drugs

filename = '0416-G-02'ggsave(filename = paste0(filename, ".pdf"), width = 11, height = 14, device = cairo_pdf)ggsave(filename = paste0(filename, ".png"), width = 11, height = 14, dpi = 100, device = "png")

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: 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=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] showtext_0.9-5 showtextdb_3.0 sysfonts_0.8.8 patchwork_1.1.2## [5] cartogram_0.2.2 maptools_1.1-4 sp_1.5-0 forcats_0.5.2 ## [9] stringr_1.4.1 dplyr_1.0.10 purrr_0.3.4readr_2.1.2 ## [13] tidyr_1.2.1tibble_3.1.8 ggplot2_3.3.6 tidyverse_1.3.2## [17] sf_1.0-8 ## ## loaded via a namespace (and not attached):## [1] fs_1.5.2 lubridate_1.8.0httr_1.4.4 ## [4] tools_4.2.1 backports_1.4.1bslib_0.4.0 ## [7] utf8_1.2.2R6_2.5.1 KernSmooth_2.23-20 ## [10] DBI_1.1.3 colorspace_2.0-3 withr_2.5.0 ## [13] tidyselect_1.1.2 compiler_4.2.1textshaping_0.3.6 ## [16] cli_3.3.0 rvest_1.0.3 xml2_1.3.3 ## [19] sass_0.4.2scales_1.2.1 classInt_0.4-8## [22] proxy_0.4-27 systemfonts_1.0.4 digest_0.6.29## [25] foreign_0.8-82rmarkdown_2.16pkgconfig_2.0.3 ## [28] htmltools_0.5.3highr_0.9 dbplyr_2.2.1 ## [31] fastmap_1.1.0 rlang_1.0.5 readxl_1.4.1 ## [34] rstudioapi_0.14jquerylib_0.1.4generics_0.1.3## [37] farver_2.1.1 jsonlite_1.8.0googlesheets4_1.0.1## [40] magrittr_2.0.3s2_1.1.0 Rcpp_1.0.9 ## [43] munsell_0.5.0 fansi_1.0.3 lifecycle_1.0.1 ## [46] stringi_1.7.8 yaml_2.3.5snakecase_0.11.0 ## [49] grid_4.2.1crayon_1.5.1 lattice_0.20-45 ## [52] haven_2.5.1 hms_1.1.2 knitr_1.40 ## [55] pillar_1.8.1 wk_0.6.0 reprex_2.0.2 ## [58] glue_1.6.2evaluate_0.16 rcartocolor_2.0.0 ## [61] modelr_0.1.9 vctrs_0.4.1 tzdb_0.3.0 ## [64] cellranger_1.1.0 gtable_0.3.1 packcircles_0.3.4 ## [67] assertthat_0.2.1 cachem_1.0.6 xfun_0.32## [70] janitor_2.1.0 broom_1.0.1 e1071_1.7-11 ## [73] ragg_1.2.3class_7.3-20 googledrive_2.0.0 ## [76] gargle_1.2.1 units_0.8-0 ellipsis_0.3.2

测试数据

配套数据下载：global_mortality.xlsx