700字范文 > 0416-A · Global Mortality · ggplot2 散点图 ggbump 凹凸图 · R 语言数据可视化案例源码

0416-A · Global Mortality · ggplot2 散点图 ggbump 凹凸图 · R 语言数据可视化案例源码

时间：2023-06-08 13:44:25

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

年合集传送门：

Global Mortality

What do people die from?

Tidy Tuesday 在 GitHub 上的传送地址： **Thomas Mock (). Tidy Tuesday: A weekly data project aimed at the R ecosystem.** [/rfordatascience/tidytuesday](/rfordatascience/tidytuesday)

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

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

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

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

1. 一些环境设置

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

2. 设置工作路径

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

3. 加载 R 包

library(tidyverse)library(ggbump)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 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 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 %>% # 从宽数据透视到长数据转换pivot_longer(cols = 4:35, names_to = "cause", values_to = "percent") %>% # 筛选数据filter(country == "World") %>% group_by(year) %>% # 建议使用 dplyr::mutate 形式调用函数, 不然容易与 plyr 中的函数冲突 (因为我自己就报错了...)dplyr::mutate(rank = min_rank(desc(percent))) %>% ungroup() %>% dplyr::mutate(cause = str_remove(cause, "[[:space:]]\$%\$"),color_albert = case_when(cause == "HIV/AIDS" ~ "HIV/AIDS",cause == "Conflict" ~ "冲突",cause == "Malaria" ~ "疟疾",cause == "Natural disasters" ~ "自然灾害",cause == "Cancers" ~ "癌症",cause == "Diabetes" ~ "糖尿病",cause == "Dementia" ~ "精神错乱",TRUE ~ "其他因素"))df_plot.one <- df_tidy %>% filter(color_albert == "其他因素")df_plot.two <- df_tidy %>% filter(color_albert != "其他因素")# 删除缺失值的观测df_tidy <- na.omit(df_tidy)df_plot.one <- na.omit(df_plot.one)df_plot.two <- na.omit(df_plot.two)# 简要查看数据内容glimpse(df_tidy)

## Rows: 862## Columns: 7## $ country<chr> "World", "World", "World", "World", "World", "World", "Wo…## $ country_code <chr> "OWID_WRL", "OWID_WRL", "OWID_WRL", "OWID_WRL", "OWID_WRL…## $ year <dbl> 1990, 1990, 1990, 1990, 1990, 1990, 1990, 1990, 1990, 199…## $ cause <chr> "Cardiovascular diseases", "Cancers", "Respiratory diseas…## $ percent<dbl> 26.5037427, 12.2480991, 7.0684616, 3.4360712, 2.0611337, …## $ rank <int> 1, 2, 3, 8, 10, 4, 5, 6, 9, 12, 7, 15, 11, 22, 13, 14, 21…## $ color_albert <chr> "其他因素", "癌症", "其他因素", "糖尿病", "精神错乱", "其…

6. 利用 ggplot2 绘图

# PS: 方便讲解, 我这里进行了拆解, 具体使用时可以组合在一起gg <- ggplot(df_plot.one, aes(year, rank, group = cause))# geom_bump() 可以用来绘制凹凸图 (bump charts)gg <- gg + geom_bump(size = 0.7, alpha = 0.7, color = "grey")# geom_point() 绘制散点图gg <- gg + geom_point(size = 1.5, color = "grey")gg <- gg + geom_text(data = df_plot.one %>% filter(year == 1990), aes(x = 1989, y = rank, label = rank),hjust = 1, size = 3)gg <- gg + geom_text(data = df_plot.one %>% filter(year == ), aes(x = .2, y = rank, label = cause),hjust = 0,size = 3)gg <- gg + geom_bump(data = df_plot.two, aes(year, rank, group = cause, colour = color_albert), size = 1)gg <- gg + geom_point(data = df_plot.two, aes(year, rank, group = cause, colour = color_albert), size = 1.8)gg <- gg + geom_text(data = df_plot.two %>% filter(year == 1990), aes(x = 1989, y = rank, label = rank),size = 3.95,hjust = 1,color = 'red',fontface = "bold")gg <- gg + geom_text(data = df_plot.two %>% filter(year == ), aes(x = .2, y = rank, label = cause),size = 2.98,hjust = 0,color = 'red',fontface = "bold")# scale_color_manual() 采取的是手动赋值的方法, 也就是直接把颜色序列赋值给它的参数 valuegg <- gg + scale_color_manual(values = c("#F61220", "#201B2A", "#1A9623", "#D2691E", "#0C55E2", "#2E2D41", "#FFD700"))# scale_y_reverse() 逆转坐标轴gg <- gg + scale_y_reverse(breaks = 1:32, expand = c(0.01, 0.01))gg <- gg + scale_x_continuous(breaks = seq(1990, , by = 2), limits = c(1989, 2026))gg <- gg + labs(title = "世界范围内的死亡原因",subtitle = "历年死亡变化情况",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(),# axis.text.y Y-坐标轴文本axis.text.y = element_blank(),# plot.title 主标题plot.title = element_text(hjust = 0.1, color = "black", size = 20, face = "bold"),# plot.subtitle 次要标题plot.subtitle = element_text(hjust = 0.1, color = "red", size = 12),# plot.caption 说明文字plot.caption = element_text(hjust = 0.85),# legend.position 设置图例位置, "none" 表示不显示图例legend.position = "none",# plot.background 图片背景plot.background = element_rect(fill = "white"))

7. 保存图片到 PDF 和 PNG

gg

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