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

人口金字塔图是描述一个地区或国家人口结构类型的常用图示方式,今天我们介绍一下如何利用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语言制作人口金字塔图,利用本程序的思路,稍微修改,可以批量制作金字塔图。

©著作权归作者所有,转载或内容合作请联系作者
  • 序言:七十年代末,一起剥皮案震惊了整个滨河市,随后出现的几起案子,更是在滨河造成了极大的恐慌,老刑警刘岩,带你破解...
    沈念sama阅读 204,793评论 6 478
  • 序言:滨河连续发生了三起死亡事件,死亡现场离奇诡异,居然都是意外死亡,警方通过查阅死者的电脑和手机,发现死者居然都...
    沈念sama阅读 87,567评论 2 381
  • 文/潘晓璐 我一进店门,熙熙楼的掌柜王于贵愁眉苦脸地迎上来,“玉大人,你说我怎么就摊上这事。” “怎么了?”我有些...
    开封第一讲书人阅读 151,342评论 0 338
  • 文/不坏的土叔 我叫张陵,是天一观的道长。 经常有香客问我,道长,这世上最难降的妖魔是什么? 我笑而不...
    开封第一讲书人阅读 54,825评论 1 277
  • 正文 为了忘掉前任,我火速办了婚礼,结果婚礼上,老公的妹妹穿的比我还像新娘。我一直安慰自己,他们只是感情好,可当我...
    茶点故事阅读 63,814评论 5 368
  • 文/花漫 我一把揭开白布。 她就那样静静地躺着,像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上,一...
    开封第一讲书人阅读 48,680评论 1 281
  • 那天,我揣着相机与录音,去河边找鬼。 笑死,一个胖子当着我的面吹牛,可吹牛的内容都是我干的。 我是一名探鬼主播,决...
    沈念sama阅读 38,033评论 3 399
  • 文/苍兰香墨 我猛地睁开眼,长吁一口气:“原来是场噩梦啊……” “哼!你这毒妇竟也来了?” 一声冷哼从身侧响起,我...
    开封第一讲书人阅读 36,687评论 0 258
  • 序言:老挝万荣一对情侣失踪,失踪者是张志新(化名)和其女友刘颖,没想到半个月后,有当地人在树林里发现了一具尸体,经...
    沈念sama阅读 42,175评论 1 300
  • 正文 独居荒郊野岭守林人离奇死亡,尸身上长有42处带血的脓包…… 初始之章·张勋 以下内容为张勋视角 年9月15日...
    茶点故事阅读 35,668评论 2 321
  • 正文 我和宋清朗相恋三年,在试婚纱的时候发现自己被绿了。 大学时的朋友给我发了我未婚夫和他白月光在一起吃饭的照片。...
    茶点故事阅读 37,775评论 1 332
  • 序言:一个原本活蹦乱跳的男人离奇死亡,死状恐怖,灵堂内的尸体忽然破棺而出,到底是诈尸还是另有隐情,我是刑警宁泽,带...
    沈念sama阅读 33,419评论 4 321
  • 正文 年R本政府宣布,位于F岛的核电站,受9级特大地震影响,放射性物质发生泄漏。R本人自食恶果不足惜,却给世界环境...
    茶点故事阅读 39,020评论 3 307
  • 文/蒙蒙 一、第九天 我趴在偏房一处隐蔽的房顶上张望。 院中可真热闹,春花似锦、人声如沸。这庄子的主人今日做“春日...
    开封第一讲书人阅读 29,978评论 0 19
  • 文/苍兰香墨 我抬头看了看天上的太阳。三九已至,却和暖如春,着一层夹袄步出监牢的瞬间,已是汗流浃背。 一阵脚步声响...
    开封第一讲书人阅读 31,206评论 1 260
  • 我被黑心中介骗来泰国打工, 没想到刚下飞机就差点儿被人妖公主榨干…… 1. 我叫王不留,地道东北人。 一个月前我还...
    沈念sama阅读 45,092评论 2 351
  • 正文 我出身青楼,却偏偏与公主长得像,于是被迫代替她去往敌国和亲。 传闻我的和亲对象是个残疾皇子,可洞房花烛夜当晚...
    茶点故事阅读 42,510评论 2 343

推荐阅读更多精彩内容