加载R包
## R version 4.4.0 (2024-04-24)
## Platform: aarch64-apple-darwin20
## Running under: macOS Sonoma 14.5
##
## Matrix products: default
## BLAS: /Library/Frameworks/R.framework/Versions/4.4-arm64/Resources/lib/libRblas.0.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/4.4-arm64/Resources/lib/libRlapack.dylib; LAPACK version 3.12.0
##
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
##
## time zone: Asia/Shanghai
## tzcode source: internal
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] lubridate_1.9.3 forcats_1.0.0 stringr_1.5.1 dplyr_1.1.4
## [5] purrr_1.0.2 readr_2.1.5 tidyr_1.3.1 tibble_3.2.1
## [9] ggplot2_3.5.1 tidyverse_2.0.0 MetBrewer_0.2.0
##
## loaded via a namespace (and not attached):
## [1] gtable_0.3.5 jsonlite_1.8.8 compiler_4.4.0 highr_0.11
## [5] tidyselect_1.2.1 jquerylib_0.1.4 scales_1.3.0 yaml_2.3.8
## [9] fastmap_1.2.0 R6_2.5.1 generics_0.1.3 knitr_1.47
## [13] munsell_0.5.1 tzdb_0.4.0 bslib_0.7.0 pillar_1.9.0
## [17] rlang_1.1.4 utf8_1.2.4 stringi_1.8.4 cachem_1.1.0
## [21] xfun_0.44 sass_0.4.9 timechange_0.3.0 cli_3.6.3
## [25] withr_3.0.0 magrittr_2.0.3 digest_0.6.35 grid_4.4.0
## [29] rstudioapi_0.16.0 hms_1.1.3 lifecycle_1.0.4 vctrs_0.6.5
## [33] evaluate_0.24.0 glue_1.7.0 prettydoc_0.4.1 fansi_1.0.6
## [37] colorspace_2.1-0 rmarkdown_2.27 tools_4.4.0 pkgconfig_2.0.3
## [41] htmltools_0.5.8.1数据清洗
# 筛选所需年龄段的数据
dff <- read_tsv("GBD_ASDR_Male.xls") %>%
filter(age %in% c("<5 years","5-9 years","10-14 years","15-19 years","20-24 years",
"25-29 years","30-34 years","35-39 years","40-44 years","45-49 years",
"50-54 years","55-59 years","60-64 years","65-69 years","70-74 years",
"75-79 years","80-84 years","85-89 years","90-94 years","95+ years")) %>%
select(measure,val,location,year,sex,age)
# 定义因子按顺序排序
dff$age <- factor(dff$age,levels = dff$age %>% unique())绘制热图-1
dff %>% ggplot()+
geom_tile(aes(x =year, y = age,fill=val))+
facet_wrap(.~location,ncol=4)+ # 按location进行分面，4列进行展示
scale_x_continuous(expand = c(0,0))+
scale_y_discrete(expand=c(0,0))+
# 设置填充色
scale_fill_gradientn(colors=rev(met.brewer("VanGogh2")))+
labs(x=NULL,y=NULL)+
theme_classic()+
theme(
axis.text.x=element_text(color="black",size=6),
axis.text.y=element_text(color="black",size=6),
panel.background = element_blank(),
plot.background = element_blank(),
panel.spacing.x = unit(0.01,"cm"),
strip.background = element_blank(),
strip.text = element_text(color="black",face="bold")) +
# 定义图例属性
guides(fill=guide_colourbar(direction ="vertical",
theme = theme(legend.frame = element_rect(colour = "black"),
legend.ticks = element_blank(),
legend.title = element_blank(),
# 设置图例与图一样高度
legend.key.height = unit(1,"null"))))
绘制热图-2
图2主要通过将数值转化为范围区间来进行填充色映射，其主要思路为根据val进行范围划分使用case_when()函数即可完成，需要注意实际数据范围区间。
dff$val %>% max() # 查看范围区间
dff$val %>% min()
# 划分范围
dff2 <- dff %>%
mutate(val_range = case_when(
val < 0.2 ~ "<0.2",
val >= 0.2 & val < 0.5 ~ "0.2-0.5",
val >= 0.5 & val < 1.0 ~ "0.5-1.0",
val >= 1.0 & val < 2.0 ~ "1.0-2.0",
val >= 2.0 & val < 3.0 ~ "2.0-3.0",
val >= 3.0 & val < 4.0 ~ "3.0-4.0",
val >= 4.0 & val < 6.0 ~ "4.0-6.0",
val >= 6.0 & val < 8.1 ~ "6.0-8.1",
val >= 8.1 & val < 10.9 ~ "8.1-10.9",
val >= 10.9 & val < 14.7 ~ "10.9-14.7",
val >= 14.7 & val < 19.9 ~ "14.7-19.9",
val >= 19.9 & val < 26.8 ~ "19.9-26.8",
val >= 26.8 & val < 36.2 ~ "26.8-36.2",
val >= 36.2 & val < 48.9 ~ "36.2-48.9",
val >= 48.9 & val < 66.0 ~ "48.9-66.0",
val >= 66.0 & val < 89.1 ~ "66.0-89.1",
val >= 89.1 & val < 120.2 ~ "89.1-120.2",
val >= 120.2 ~ ">120.2"
))
# 定义因子按顺序排序
dff2$val_range <- factor(dff2$val_range,
levels = c("<0.2", "0.2-0.5", "0.5-1.0", "1.0-2.0", "2.0-3.0",
"3.0-4.0", "4.0-6.0","6.0-8.1", "8.1-10.9","10.9-14.7",
"14.7-19.9", "19.9-26.8", "26.8-36.2", "36.2-48.9",
"48.9-66.0", "66.0-89.1", "89.1-120.2", ">120.2"))
# 定义年龄因子
dff2$age <- factor(dff2$age,levels = dff2$age %>% unique())
# 绘制图形
dff2 %>% ggplot() +
geom_tile(aes(x = year, y = age, fill = val_range)) +
facet_wrap(.~location, ncol = 4) +
scale_x_continuous(expand = c(0,0)) +
scale_y_discrete(expand = c(0,0))+
# 此处按离散型数据进行映射，由于分为18组因此取对应数量的颜色值
scale_fill_manual(values = rev(paste(met.brewer("VanGogh2",n=18,type="continuous"))))+
labs(x = NULL, y = NULL) +
theme_classic() +
theme(
axis.text.x = element_text(color = "black", size = 6),
axis.text.y = element_text(color = "black", size = 6),
panel.background = element_blank(),
plot.background = element_blank(),
panel.spacing.x = unit(0.01, "cm"),
strip.background = element_blank(),
strip.text = element_text(color = "black", face = "bold"),
legend.background = element_blank(),
legend.title = element_blank(),
legend.key.width = unit(0.5,"cm"),
legend.key.height = unit(0.2,"cm"),
legend.position = "top")+
# 设置图例属性，分两行展示
guides(fill=guide_legend(nrow = 2,reverse=F))
图形解读
此图展示了不同地区（全球、高SDI、低SDI和中SDI）在1990年到2017年间，不同年龄段的死亡率。图中使用了颜色渐变来表示死亡率的区间，不同的颜色代表不同的死亡率范围。
- 纵轴（Y轴）：年龄段，从小于5岁到95岁及以上。
- 横轴（X轴）：年份，从1990年到2017年。
- 颜色块：表示每个年龄段在每一年中的死亡率。
不同地区的死亡率比较
1.全球：显示全球范围内的死亡率情况。
2.高SDI（社会人口发展指数）：表示高SDI地区的死亡率，这些地区一般拥有更高的经济发展和医疗水平。
3.低SDI：表示低SDI地区的死亡率，这些地区通常经济较不发达，医疗水平较低。
4.中SDI：表示中SDI地区的死亡率，这些地区的经济和医疗水平介于高SDI和低SDI之间。