人口金字塔图（双侧图）

library(data.table)
library(dplyr)
library(ggplot2) # 读取数据
df <- fread("examples/gbd_input.csv") # 定义年龄段（5岁一组）
age_groups <- 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", "85-89", "90-94", "95+ years") # 筛选数据
# 条件：2021年、中国、排除Both、Number、患病率
data_pyramid <- subset(df, year == 2021 & location_name == 'China' & sex_name != 'Both' & metric_name == 'Number' & measure_name == 'Prevalence' & age_name %in% age_groups
) # 选择需要的列
data_pyramid <- data_pyramid[, .(sex_name, age_name, val, upper, lower)] # 去除 "years" 文字
data_pyramid$age_name <- gsub(" years", "", data_pyramid$age_name) # 转换为因子并排序
data_pyramid$age_name <- factor(data_pyramid$age_name, levels = c("<5", "5-9", "10-14", "15-19", "20-24", "25-29", "30-34", "35-39", "40-44", "45-49", "50-54", "55-59", "60-64", "65-69", "70-74", "75-79", "80-84", "85-89", "90-94", "95+")) # 按性别和年龄排序
data_pyramid <- data_pyramid[order(sex_name, age_name),] # 数值取整
data_pyramid$val <- round(data_pyramid$val, 0)

# 设置颜色
custom_colors <- c("Male" = "steelblue", "Female" = "#e31a1c") # 绘制金字塔图
p_pyramid <- ggplot(data_pyramid, aes(x = age_name, y = ifelse(sex_name == "Male", val, -val), # 男性为正，女性为负 fill = sex_name)) + scale_fill_manual(values = custom_colors) + # 自定义颜色 geom_bar(stat = 'identity') + # 条形图 coord_flip + # 翻转坐标轴（横向） labs(x = 'Age', y = 'Number of Cases') + # 轴标签 # 添加数值标签 geom_text(aes(label = val, hjust = ifelse(sex_name == "Male", -0.4, 1.1)), size = 2) + # Y轴显示绝对值 scale_y_continuous(labels = abs, expand = expansion(mult = c(0.2, 0.2))) + theme_minimal + theme(legend.position = "top") # 显示图形
p_pyramid # 保存图形
ggsave("examples/pyramid_prevalence.png", p_pyramid, width = 10, height = 8)

# 筛选发病数据（将 Prevalence 改为 Incidence）
data_incidence <- subset(df, year == 2021 & location_name == 'China' & sex_name != 'Both' & metric_name == 'Number' & measure_name == 'Incidence' & # 发病人数 age_name %in% age_groups
) data_incidence <- data_incidence[, .(sex_name, age_name, val)]
data_incidence$age_name <- gsub(" years", "", data_incidence$age_name)
data_incidence$age_name <- factor(data_incidence$age_name, levels = c("<5", "5-9", "10-14", "15-19", "20-24", "25-29", "30-34", "35-39", "40-44", "45-49", "50-54", "55-59", "60-64", "65-69", "70-74", "75-79", "80-84", "85-89", "90-94", "95+"))
data_incidence <- data_incidence[order(sex_name, age_name),]
data_incidence$val <- round(data_incidence$val, 0) # 绘制
p_incidence <- ggplot(data_incidence, aes(x = age_name, y = ifelse(sex_name == "Male", val, -val), fill = sex_name)) + scale_fill_manual(values = c("Male" = "#1f78b4", "Female" = "#e31a1c")) + geom_bar(stat = 'identity') + coord_flip + labs(x = 'Age', y = 'Number of Incidence') + geom_text(aes(label = val, hjust = ifelse(sex_name == "Male", -0.4, 1.1)), size = 2) + scale_y_continuous(labels = abs, expand = expansion(mult = c(0.2, 0.2))) + theme_minimal + theme(legend.position = "top") p_incidence

library(ggpubr) # 合并患病和发病两个金字塔图
# 按列排列（上下堆叠）
p_combined <- ggarrange(p_pyramid, p_incidence, ncol = 1, labels = c("A) Prevalence", "B) Incidence")) # 保存
ggsave("examples/pyramid_combined.png", p_combined, width = 12, height = 14) # 按行排列（左右并排）
p_sideby <- ggarrange(p_pyramid, p_incidence, ncol = 2, labels = c("Prevalence", "Incidence"))
ggsave("examples/pyramid_sideby.png", p_sideby, width = 16, height = 8)

# 人口金字塔图一键生成函数
generate_pyramid <- function(input_file, output_dir = "examples/", location = "China", year = 2021, measure = c("Prevalence", "Incidence")) { library(data.table) library(dplyr) library(ggplot2) library(ggpubr) df <- fread(input_file) age_groups <- 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", "85-89", "90-94", "95+ years") results <- list for (m in measure) { data <- subset(df, year == year & location_name == location & sex_name != 'Both' & metric_name == 'Number' & measure_name == m & age_name %in% age_groups) data <- data[, .(sex_name, age_name, val)] data$age_name <- gsub(" years", "", data$age_name) data$age_name <- factor(data$age_name, levels = c("<5", "5-9", "10-14", "15-19", "20-24", "25-29", "30-34", "35-39", "40-44", "45-49", "50-54", "55-59", "60-64", "65-69", "70-74", "75-79", "80-84", "85-89", "90-94", "95+")) data <- data[order(sex_name, age_name),] data$val <- round(data$val, 0) p <- ggplot(data, aes(x = age_name, y = ifelse(sex_name == "Male", val, -val), fill = sex_name)) + scale_fill_manual(values = c("Male" = "steelblue", "Female" = "#e31a1c")) + geom_bar(stat = 'identity') + coord_flip + labs(x = 'Age', y = paste('Number of', m)) + geom_text(aes(label = val, hjust = ifelse(sex_name == "Male", -0.4, 1.1)), size = 2) + scale_y_continuous(labels = abs, expand = expansion(mult = c(0.2, 0.2))) + theme_minimal + theme(legend.position = "top") ggsave(paste0(output_dir, "pyramid_", tolower(m), ".png"), p, width = 10, height = 8) results[[m]] <- p } return(results)
} # 使用示例
generate_pyramid("examples/gbd_input.csv", measure = c("Prevalence", "Incidence"))