利用ggplot2制作金字塔图，展示人口结构数据

R

科研作图

作者头像 陈琼博士 · 发布于 2022年2月21日 · 最后更新于 2025年4月6日

1 什么是人口金字塔图？

人口金字塔是用类似古埃及金字塔的形象描绘人口年龄和性别分布状况的图形。能表明人口现状及其发展类型，比如看一个地区或国家的人口结构类型是扩展型、稳定型或者收缩型。

图形的画法是：按男女人口年龄自然顺序自下而上在纵轴左右画成并列的横条柱，各条柱代表各个年龄组。底端标有按一定计算单位或百分比表示的人口数量。

下面我们介绍一下如何利用R画出人口金字塔图。

2 用到哪些R包？

今天主要用到 dplyr包、reshape2包、ggplot2包和cowplot包。 dplyr包和reshape2包用来进行数据整理，ggplot2包和cowplot包用来画图和整合。

3 加载这些R包

library(dplyr)

Attaching package: 'dplyr'
The following objects are masked from 'package:stats':

    filter, lag
The following objects are masked from 'package:base':

    intersect, setdiff, setequal, union
library(reshape2)
library(ggplot2)
library(cowplot)

4 数据处理

首先需要把我们手里的现有数据读取到R工作环境，然后把数据调整为ggplot2包绘图所需要的格式。

我们看一下，我们目前的数据结构和变量基本信息吧，目前我们有一个数据框，数据框里有20列数据，第一列为性别(sex),其余分别为0，1，4~，…，85+岁组各年龄组的人口数据。

pop  <- read.csv("pop.csv")
Warning in read.table(file = file, header = header, sep = sep, quote = quote, :
incomplete final line found by readTableHeader on 'pop.csv'
pop <- pop %>%
  #把合计人口数去掉只保留男性和女性人口
  filter(sex %in% c("男性","女性"))
head(pop)
   sex     r0     r1      r5     r10     r15     r20     r25     r30     r35
1 男性 193565 924420 1186130 1158427 1130776 1254271 1426065 1291455 1279639
2 女性 176068 821772 1038768  991518 1002524 1162174 1365563 1235362 1208151
      r40     r45     r50    r55    r60    r65    r70    r75    r80    r85
1 1322747 1338809 1145094 941395 812746 622679 440440 300147 183825 102596
2 1261624 1292094 1101333 918208 801106 635924 467743 342476 228937 164663

但是，ggplot2绘图需要读取纵向格式的数据，也就是说我们需要把目前的数据格式转换成两列，一列为性别，另一列为人口数。因此，我们需要把目前的数据转换成纵向结构数据。

reshape2包的melt函数可以把横向数据转换为纵向数据，id.vars参数指定保留的变量名称，其余的变量都转职置为纵向结构，转换为两列，一列存放变量名，一列存放变量值。variable.name指定存放变量名的那一列的变量名，value.name指定存放变量值的那一列的变量名。

# 对横向数据进行转置，然后存入pop数据框
pop <- pop %>%
# reshape2包的melt函数转置横向数据
  melt(id.vars=c("sex"),
       variable.name="age",
       value.name = "pop")

现在来看看转置后的数据吧

head(pop)
   sex age     pop
1 男性  r0  193565
2 女性  r0  176068
3 男性  r1  924420
4 女性  r1  821772
5 男性  r5 1186130
6 女性  r5 1038768

然后把目前pop数据框的age变量值进行转换，因为它的值就是人口金字塔中显示的年龄组的值。

pop<-pop%>%
  mutate(age=as.numeric(gsub("r","",age)),
         pop=ifelse(sex=="男性",-pop,pop))

绘制人口金字塔的时候，横条的长度采用跟年龄组人口数占相应人口的百分比来表示，因此计算人口百分比数据。

age_label<- c("0","1-4","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-")
pop <- pop%>%
  group_by(sex)%>%
  mutate(pop_rate=pop/sum(pop)*100)%>%
  mutate(pop_rate=ifelse(sex=="男性",-pop_rate,pop_rate))

然后把人口数据拆分成男性和女性两个数据框，并把这个两个数据框存入列表ct

ct <- pop%>%group_by(sex)%>%group_split()
ct
<list_of<
  tbl_df<
    sex     : character
    age     : double
    pop     : integer
    pop_rate: double
  >
>[2]>
[[1]]
# A tibble: 19 × 4
   sex     age     pop pop_rate
   <chr> <dbl>   <int>    <dbl>
 1 女性      0  176068     1.09
 2 女性      1  821772     5.07
 3 女性      5 1038768     6.41
 4 女性     10  991518     6.11
 5 女性     15 1002524     6.18
 6 女性     20 1162174     7.17
 7 女性     25 1365563     8.42
 8 女性     30 1235362     7.62
 9 女性     35 1208151     7.45
10 女性     40 1261624     7.78
11 女性     45 1292094     7.97
12 女性     50 1101333     6.79
13 女性     55  918208     5.66
14 女性     60  801106     4.94
15 女性     65  635924     3.92
16 女性     70  467743     2.88
17 女性     75  342476     2.11
18 女性     80  228937     1.41
19 女性     85  164663     1.02

[[2]]
# A tibble: 19 × 4
   sex     age      pop pop_rate
   <chr> <dbl>    <int>    <dbl>
 1 男性      0  -193565   -1.13 
 2 男性      1  -924420   -5.42 
 3 男性      5 -1186130   -6.95 
 4 男性     10 -1158427   -6.79 
 5 男性     15 -1130776   -6.63 
 6 男性     20 -1254271   -7.35 
 7 男性     25 -1426065   -8.36 
 8 男性     30 -1291455   -7.57 
 9 男性     35 -1279639   -7.50 
10 男性     40 -1322747   -7.76 
11 男性     45 -1338809   -7.85 
12 男性     50 -1145094   -6.71 
13 男性     55  -941395   -5.52 
14 男性     60  -812746   -4.77 
15 男性     65  -622679   -3.65 
16 男性     70  -440440   -2.58 
17 男性     75  -300147   -1.76 
18 男性     80  -183825   -1.08 
19 男性     85  -102596   -0.602

为了使用方便，我们编制一个函数，并利用lapply函数把ct列表放入进去，这样就可以自动生成横向条形图。

5 制作金字塔图的思路

我们先编写一个函数，实现对列表数据进行处理，判断如果是男性数据的话则生成左侧横向条形图，如果是女性数据的话则生成右侧横向条形图，然后把利用cowplot把左侧条形图和右侧条形图组成一个金字塔图。

上程序：

# top_value <-  max(abs(pop$pop_rate)) 
p<- lapply(ct,function(x) {
  sexx <- x[1,c("sex")]
  abslabel <- function(x) {paste(abs(x),"%",sep="")}
  mycolor <- ifelse(sexx=="男性",paste("steelblue"),paste("red"))
  pp<-ggplot(x) + 
    geom_bar(aes(x=pop_rate,y=factor(age,labels=age_label)), stat = "identity",color="white",width=0.9,fill=ifelse(x$pop_rate>0,'#e31a1c','#1f78b4'))+
    scale_x_continuous(expand = expansion(),limits=c(0,9.9),labels=abslabel)+
    xlab(ifelse(sexx=="男性","男性","女性"))+
    theme_void()+
    theme(
      axis.title.y = element_blank(),
      panel.border = element_blank(),
      panel.grid=element_blank(),
      panel.grid.major =element_blank(),
      axis.ticks.y = element_blank(),
      axis.line.y=element_blank(),
      axis.text.x = element_text(face="bold"),
      axis.text.y =element_text(size=12),
      axis.title.x=element_text(size=12)
    )
  if (sexx=="男性"){ pp<- pp+ theme(axis.text.y =element_blank())+scale_x_continuous(expand = expansion(),limits=c(-9.9,0),labels=abslabel)
  }
  return(pp)
})
Scale for x is already present.
Adding another scale for x, which will replace the existing scale.

上面的程序有已经把生成的左侧和右侧条形图放入列表p，下面把列表的第一个元素和第二个元素利用cowplot组合起来就是一个金字塔图了。

# 利用plot_grid来组合p列表元素，进行横向拼接，存入pyramid
pyramid <- plot_grid(p[[1]],p[[2]],ncol=2,align="hv")

我们来看看最终的金字塔图的吧。

pyramid

科研作图，人口金字塔图

6 小结

本篇文章介绍了如何利用R语言制作人口金字塔图，利用本程序的思路，稍微修改，可以批量制作金字塔图。

如果你对本篇文章有任何建议，请在页面进行评论吧！

陈琼博士

陈 琼

博士 副主任医师

他从事肿瘤登记与人群流行病学研究，编写肿瘤登记年报，并开发和维护个人网站。他撰写博文，分享数据分析方法、可视化技巧和自动化报告解决方案，同时学习 R 语言，开发 R 包，不断探索高效的数据处理与展示方式。 🚀

回到顶部