结果图

图形解读

20岁以下数据较少因此剔除掉，通过面积图分组对数据进行展示，每一年龄段均展示1990-2019年数据的变化情况，通过面积图可更加直观的查看数据随时间的变化趋势。

加载R包

library(tidyverse)
library(gridExtra)
sessionInfo()
## 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] gridExtra_2.3   lubridate_1.9.3 forcats_1.0.0   stringr_1.5.1  
##  [5] dplyr_1.1.4     purrr_1.0.2     readr_2.1.5     tidyr_1.3.1    
##  [9] tibble_3.2.1    ggplot2_3.5.1   tidyverse_2.0.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.36     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

定义绘图函数

plot_variable <- function(data) {
  ggplot(data, aes(x = year, y = val)) +
    geom_area(fill = "skyblue", color = "black") +
    scale_x_continuous() +
    scale_y_continuous(expand = c(0, 0)) +
    facet_wrap(~age, strip.position = "bottom", nrow = 1) +
    labs(x = NULL, y = NULL) +
    theme_classic() +
    theme(
      axis.text.x = element_blank(),
      axis.ticks.x = element_blank(),
      panel.spacing.x = unit(0, "cm"),
      strip.placement = "none",
      strip.text = element_text(color = "black", size =7),
      strip.background = element_blank(),
      plot.background = element_blank(),
      panel.background = element_blank(),
      plot.title = element_text(vjust=0.5,hjust=0.5,size=10)
    )
  
}

数据清洗

# 筛选出所需年龄段
df <- read_tsv("GBD_ASDR_Male.xls") %>%
  filter(age %in% c("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")) %>%
  mutate(age = str_replace(age, " years", "")) %>%
  mutate(val = round(val, digits = 2))

# 定义年龄因子
df$age <- factor(df$age, levels = df$age %>% unique())

locations <- df$location %>% unique()

循环绘图

plots <- lapply(locations, function(loc) {
  data_filtered <- df %>% filter(location == loc)
  plot <- plot_variable(data_filtered) + ggtitle(loc)
  ggsave(filename = paste0(loc, ".pdf"),width=5.92,height=3.79,plot = plot,dpi=300)
  return(plot)
})
# 此处的图片大小应根据自己数据来设置

# 拼图
do.call(gridExtra::grid.arrange, c(plots, ncol = 2))