人口金字塔图是描述一个地区或国家人口结构类型的常用图示方式，今天我们介绍一下如何利用R语言制作金字塔图，快来看看如何作金字塔图吧！
什么是人口金字塔图？
人口金字塔是用类似古埃及金字塔的形象描绘人口年龄和性别分布状况的图形。能表明人口现状及其发展类型，比如看一个地区或国家的人口结构类型是扩展型、稳定型或者收缩型。
图形的画法是：按男女人口年龄自然顺序自下而上在纵轴左右画成并列的横条柱，各条柱代表各个年龄组。底端标有按一定计算单位或百分比表示的人口数量。
下面我们介绍一下如何利用R画出人口金字塔图。
用到哪些R包？
今天主要用到 dplyr包、reshape2包、ggplot2包和cowplot包。 dplyr包和reshape2包用来进行数据整理，ggplot2包和cowplot包用来画图和整合。
加载这些R包
library(dplyr)
##
## 载入程辑包：'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)
数据处理
首先需要把我们手里的现有数据读取到R工作环境，然后把数据调整为ggplot2包绘图所需要的格式。
我们看一下，我们目前的数据结构和变量基本信息吧，目前我们有一个数据框，数据框里有20列数据，第一列为性别(sex),其余分别为0，1，4~，...，85+岁组各年龄组的人口数据。
pop <- read.csv("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 x 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
##
## [[2]]
## # A tibble: 19 x 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
为了使用方便，我们编制一个函数，并利用lapply函数把ct列表放入进去，这样就可以自动生成横向条形图。
制作金字塔图的思路
我们先编写一个函数，实现对列表数据进行处理，判断如果是男性数据的话则生成左侧横向条形图，如果是女性数据的话则生成右侧横向条形图，然后把利用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)
})
上面的程序有已经把生成的左侧和右侧条形图放入列表p，下面把列表的第一个元素和第二个元素利用cowplot组合起来就是一个金字塔图了。
# 利用plot_grid来组合p列表元素，进行横向拼接，存入pyramid
pyramid <- plot_grid(p[[1]],p[[2]],ncol=2,align="hv")
我们来看看最终的金字塔图的吧。
pyramid
小结
本篇文章介绍了如何利用R语言制作人口金字塔图，利用本程序的思路，稍微修改，可以批量制作金字塔图。
