所有作品合集传送门： 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-b'
setwd(wkdir)

3. 加载 R 包

library(scales)
library(reshape2)
library(tidyverse)
library(RColorBrewer)
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 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 alberte (%)`                    <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 alberttory 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] "albertral disasters (%)"                   
## [34] "Conflict (%)"                            
## [35] "Terrorism (%)"

5. 数据预处理

# 从列名中删除 (%)
names(df_input) <- str_trim(str_remove_all(names(df_input), "[[:punct:]]"))
# 按年(2016年) 和 国家(China) 划分的子集数据
df_alb <- subset(df_input, year == 2016) %>% subset(countrycode == "CHN")
# 删除 国家代码(countrycode) 和 年份(year) 列
df_ert <- select(df_alb, -(countrycode:year))
# 数据变形
df_tidy <- melt(df_ert)
# 将所有缺失值用 0 替换
df_tidy[is.na(df_tidy)] <- 0

# 简要查看数据内容
glimpse(df_tidy)

## Rows: 32
## Columns: 3
## $ country  <chr> "China", "China", "China", "China", "China", "China", "China"…
## $ variable <fct> Cardiovascular diseases, Cancers, Respiratory diseases, Alber…
## $ value    <dbl> 41.121472082, 24.606023731, 9.477579245, 3.662480920, 4.93380…

6. 利用 ggplot2 绘图

# 获得疾病的数量
n.disease = length(unique(df_tidy$variable))
# 选择调色板
getPalette = colorRampPalette(brewer.pal(8, "Dark2"))

# PS: 方便讲解, 我这里进行了拆解, 具体使用时可以组合在一起
gg <- ggplot(df_tidy, aes(reorder(variable, value), value, fill = variable))
# geom_bar() 绘制条形图, stat = "identity"，意味着条形的高度表示数据数据的值
gg <- gg + geom_bar(stat = "identity")
# coord_flip() 倒置坐标系
gg <- gg + coord_flip()
# Y轴添加百分比符号
gg <- gg + scale_y_continuous(breaks = seq(0, 45, by = 5), labels = function(x) paste0(x, "%"), limits = c(0, 45))
# geom_text() 添加文本信息 
gg <- gg + geom_text(data = df_tidy, aes(variable, value, label = paste(sprintf("%0.2f", round(value, digits = 2)), "%")), hjust = -0.08)
# geom_hline() 添加水平线, 需要注意的是, 这里图已经经过倒置了, 实际上添加的是垂直线
gg <- gg + geom_hline(yintercept=c(5, 10, 15, 20), linetype = "dotted", color = "orange")
# scale_fill_manual() 采取的是手动赋值的方法, 也就是直接把颜色序列赋值给它的参数 value
gg <- gg + scale_fill_manual(values = getPalette(n.disease))
gg <- gg + labs(title = "2016年·中国死亡因素分布比例",
                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.margin 调整图像边距, 上-右-下-左
  plot.margin = margin(12, 10, 2, 15), 
  # 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 = 20),
  # legend.position 设置图例位置, "none" 表示不显示图例
  legend.position = "none")

7. 保存图片到 PDF 和 PNG

gg

filename = '20180416-B-01'
ggsave(filename = paste0(filename, ".pdf"), width = 11.2, height = 5.5, device = cairo_pdf)
ggsave(filename = paste0(filename, ".png"), width = 11.2, height = 5.5, 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: 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=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     RColorBrewer_1.1-3
##  [5] forcats_0.5.2      stringr_1.4.1      dplyr_1.0.10       purrr_0.3.4       
##  [9] readr_2.1.2        tidyr_1.2.1        tibble_3.1.8       ggplot2_3.3.6     
## [13] tidyverse_1.3.2    reshape2_1.4.4     scales_1.2.1      
## 
## loaded via a namespace (and not attached):
##  [1] Rcpp_1.0.9          lubridate_1.8.0     assertthat_0.2.1   
##  [4] digest_0.6.29       utf8_1.2.2          R6_2.5.1           
##  [7] cellranger_1.1.0    plyr_1.8.7          backports_1.4.1    
## [10] reprex_2.0.2        evaluate_0.16       highr_0.9          
## [13] httr_1.4.4          pillar_1.8.1        rlang_1.0.5        
## [16] googlesheets4_1.0.1 readxl_1.4.1        rstudioapi_0.14    
## [19] jquerylib_0.1.4     rmarkdown_2.16      textshaping_0.3.6  
## [22] googledrive_2.0.0   munsell_0.5.0       broom_1.0.1        
## [25] compiler_4.2.1      modelr_0.1.9        xfun_0.32          
## [28] systemfonts_1.0.4   pkgconfig_2.0.3     htmltools_0.5.3    
## [31] tidyselect_1.1.2    fansi_1.0.3         crayon_1.5.1       
## [34] tzdb_0.3.0          dbplyr_2.2.1        withr_2.5.0        
## [37] grid_4.2.1          jsonlite_1.8.0      gtable_0.3.1       
## [40] lifecycle_1.0.1     DBI_1.1.3           magrittr_2.0.3     
## [43] cli_3.3.0           stringi_1.7.8       cachem_1.0.6       
## [46] farver_2.1.1        fs_1.5.2            xml2_1.3.3         
## [49] bslib_0.4.0         ragg_1.2.3          ellipsis_0.3.2     
## [52] generics_0.1.3      vctrs_0.4.1         tools_4.2.1        
## [55] glue_1.6.2          hms_1.1.2           fastmap_1.1.0      
## [58] yaml_2.3.5          colorspace_2.0-3    gargle_1.2.1       
## [61] rvest_1.0.3         knitr_1.40          haven_2.5.1        
## [64] sass_0.4.2

测试数据

配套数据下载：global_mortality.xlsx