绘制一个特殊的金字塔组合柱形图！

基迪奥-Jt桃

金字塔图，由两套柱形图或条形图相对组合而成，因形似金字塔而得名，常用于表示不同性别的人口年龄构成等，在社会学、流行病学等领域中都被广泛使用。

（nature communications，2022）

当然，应用情景不止人口性别，上图这个案例中就分别展示了按年龄（a）以及按接种日期（b）划分的两类不同COVID-19疫苗的接种者分布情况。

今天我们就来学习一下这类特殊的组合柱形图，包括堆叠型的金字塔图如何绘制。

1. #相关R包安装与载入：
   
2. install.packages("apyramid") #绘制金字塔图
   
3. install.packages('outbreaks') #含所需测试数据集
   
4. library(outbreaks) #测试数据
   
5. library(apyramid) #金字塔绘图包
   
6. library(ggplot2)
   
7. library(cols4all) #配色包
   

复制代码

1. 对未预先统计汇总的数据绘制金字塔图

1. #调入测试数据集：
   
2. ##2013年中国136例甲型H7N9流感病例
   
3. flu <- outbreaks::fluH7N9_china_2013
   
4. flu$age <- as.integer(flu$age)
   
5. head(flu) #每行为一个患者的相关数据
   

复制代码

1. #根据年龄段划分年龄分组：
   
2. autocut <- function(x) {
   
3. cut(x, breaks = pretty(x), right = TRUE, include.lowest = TRUE)
   
4. }
   
5. flu$age_group <- autocut(flu$age)
   
6. levels(flu$gender) <- c("Female", "Male")
   
7. head(flu)
   

复制代码

1. #绘制人口金字塔图：
   
2. p <- age_pyramid(
   
3. flu,
   
4. show_midpoint = TRUE, #是否用虚线展示每个组别中点
   
5. proportional = FALSE, #默认展示案例数，如果为TRUE则展示百分比
   
6. age_group = age_group, #年龄分组
   
7. split_by = gender #性别
   
8. )
   
9. p
   

复制代码

对于处在同一个年龄区间的总案例数，绘图时会自动帮我们完成统计，非常便捷！

1. #基于ggplot2，我们可以自由美化和定制主题
   
2. #提取配色：
   
3. c4a_gui()
   
4. mycol <- c4a('pastel1',2)
   
5. mycol
   
6. #自定义配色/主题/标签：
   
7. p1 <- p +
   
8. scale_fill_manual(values=rev(mycol)) +
   
9. theme_classic() +
   
10. labs(
    
11. x = "Age group (years)", #在图中为纵轴对应标签
    
12. y = "Number of cases", #在图中为横轴对应标签
    
13. fill = "Gender", #图例名
    
14. title = "134 cases of influenza A H7N9 in China" #图表主标题
    
15. )
    
16. p1
    

复制代码

1. #本案例中，存在两个性别缺失的数据行(绘图时默认剔除)，如果想要展示缺失数据：
   
2. mycol2 <- c4a('pastel1',3)
   
3. mycol2
   
4. p2 <- age_pyramid(flu, age_group = age_group, split_by = gender,
   
5. na.rm = FALSE) + #展示缺失数据：na.rm = FALSE
   
6. scale_fill_manual(values=rev(mycol2)) +
   
7. theme_classic() +
   
8. labs(
   
9. x = "Age group (years)",
   
10. y = "Number of cases",
    
11. fill = "Gender",
    
12. title = "136 cases of influenza A H7N9 in China"
    
13. )
    
14. p2
    

复制代码

2. 对已汇总的数据绘制金字塔图

如果我们的数据已经提前完成了每个区段的统计汇总，也可以直接调用该R包绘图。

1. #调入测试数据集：
   
2. ##美国2018年人口普查数据
   
3. dt <- us_2018
   
4. head(dt) #该数据集已根据年龄段对人口数(count)进行了汇总
   

复制代码

1. p3 <- age_pyramid(us_2018,
   
2. age_group = age,
   
3. split_by = gender,
   
4. count = count) #使用已有的汇总数据绘图
   
5. p3
   

复制代码

1. #主题美化：
   
2. mycol3 <- c4a('bright',2)
   
3. mycol3
   
4. p4 <- p3 +
   
5. scale_fill_manual(values=rev(mycol3)) +
   
6. theme_classic() +
   
7. labs(
   
8. x = "Age group",
   
9. y = "Thousands of people",
   
10. fill = "Gender",
    
11. title = "US Cenus Data 2018"
    
12. )
    
13. p4
    

复制代码

3. 堆叠金字塔图绘制

1. #额外添加其它因素作为堆叠分层
   
2. #3.1 按性别和健康保险状况分层绘制堆叠人口金字塔图
   
3. dt2 <- us_ins_2018
   
4. head(dt2)
   

复制代码

1. p5 <- age_pyramid(dt2,
   
2. age_group = age,
   
3. split_by = gender,
   
4. stack_by = insured, #按保险分层
   
5. count = count) +
   
6. scale_fill_manual(values=rev(mycol)) +
   
7. theme_classic() +
   
8. labs(
   
9. x = "Age group",
   
10. y = "Thousands of people",
    
11. fill = "insured",
    
12. title = "US Cenus Data 2018"
    
13. )
    
14. p5
    

复制代码

4. 使用ggplot2直接绘制金字塔图

更喜欢直接用ggplot2绘制也ok，我们只需要根据二分类将数据调整为一正一负后再绘制即可。

1. #数据处理：
   
2. df <- dt
   
3. df[df$gender == "female",]$count <- -df[df$gender == "female",]$count
   
4. head(df) #男-正；女-负
   

复制代码

1. #ggplot2绘制金字塔图：
   
2. p6 <- ggplot(data = df,
   
3. aes(x = age , y = count, fill = gender)) +
   
4. geom_bar(stat = "identity",position = "identity",
   
5. color="black", size = 0.25) +
   
6. scale_y_continuous(labels = abs,#显示绝对值
   
7. limits = c(-12000, 12000),
   
8. breaks = seq(-12000, 12000, 2000))
   
9. p6
   

复制代码

1. #配色/主题等美化：
   
2. p7 <- p6 +
   
3. scale_fill_manual(values=rev(mycol)) +
   
4. theme_bw() +
   
5. theme(axis.text.x = element_text(angle=60, hjust=1)) + #调整下X轴标签角度，避免重叠
   
6. labs(
   
7. x = "Age group",
   
8. y = "Thousands of people",
   
9. fill = "Gender",
   
10. title = "US Cenus Data 2018"
    
11. )
    
12. p7
    

复制代码

1. #也可以自由翻转
   
2. p7 + coord_flip()
   

复制代码

好啦，我们今天的分享就到这里！

参考资料
https://www.rdocumentation.org/packages/apyramid/versions/0.1.2

参考文献
Burn, E., Li, X., Delmestri, A. et al. Thrombosis and thrombocytopenia after vaccination against and infection with SARS-CoV-2 in the United Kingdom. Nat Commun 13, 7167 (2022).


*未经许可，不得以任何方式复制或抄袭本篇文章之部分或全部内容。版权所有，侵权必究。

本文作者：基迪奥-喵酱

森淼

十二月开始

森淼

十二月第二天