查看: 552|回复: 2

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

[复制链接]

管理员

Rank: 15Rank: 15Rank: 15Rank: 15Rank: 15

主题
954
注册时间
2020.6.16
在线时间
501 小时

发表于 2022.11.30 10:45:10 | 显示全部楼层 |阅读模式
金字塔图,由两套柱形图或条形图相对组合而成,因形似金字塔而得名,常用于表示不同性别的人口年龄构成等,在社会学、流行病学等领域中都被广泛使用。

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).


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

本文作者:基迪奥-喵酱

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?立即注册

x
新的一天加油!
回复

使用道具 举报

中华鲟

Rank: 5Rank: 5

主题
0
注册时间
2016.5.10
在线时间
35 小时

发表于 2022.12.1 15:20:29 | 显示全部楼层
十二月开始
新的一天加油!
回复 支持 反对

使用道具 举报

中华鲟

Rank: 5Rank: 5

主题
0
注册时间
2016.5.10
在线时间
35 小时

发表于 2022.12.3 15:19:08 | 显示全部楼层
十二月第二天
新的一天加油!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

快速回复 返回顶部 返回列表