人口金字塔

---

title: "pyramid"
author: "wintryheart"
date: "2019/12/2"
output: html_document

---

knitr::opts_chunk$set(echo = TRUE)

金字塔的画法

library(tidyverse)
library(ggplot2)
library(gganimate)
population <- read.csv("c:/users/liang/desktop/total.csv")

Index	X2017年	X2016年	X2015年	X2014年	X2013年	X2012年	X2011年	X2009年
总体男性人口数(人口抽样调查)(人)	586072	593087	10917046	576011	573428	576354	587039	591871
0-4岁男性人口数(人口抽样调查)(人)	36468	36703	668449	34484	34273	34694	35247	33140
5-9岁男性人口数(人口抽样调查)(人)	34344	34666	638535	34326	33890	33252	33242	34705
10-14岁男性人口数(人口抽样调查)(人)	32929	32773	598685	31616	31141	32370	33709	39749
15-19岁男性人口数(人口抽样调查)(人)	32034	33199	626249	34584	36177	38909	42066	44170
20-24岁男性人口数(人口抽样调查)(人)	38496	41366	809143	46891	50961	52033	55243	44001

pop2 <- gather(population, key = "year", value = "population", -Index)
pop2$year <- str_sub(pop2$year, 2, 5)
pop2$Index <- str_remove_all(pop2$Index, "[人口数抽样调查]")
pop2$Index <- str_remove_all(pop2$Index, "[()]")
pop2 <- mutate(pop2, sex=str_extract(pop2$Index, "[男,女]"))
pop2 <- mutate(pop2, age=str_remove_all(pop2$Index, "[男女性]"))
pop2 <- pop2[, 2:5]

year	population	sex	age
2017	586072	男	总体
2017	36468	男	0-4岁
2017	34344	男	5-9岁
2017	32929	男	10-14岁
2017	32034	男	15-19岁
2017	38496	男	20-24岁

pop3 <- filter(pop2, age!="总体")
# 计算分性别分年龄段的人口比例
pop3 <- pop3 %>%
  group_by(year) %>%
  mutate(per=population/sum(population)*100)

pop3$year <- as.numeric(pop3$year)

pop3$age <- as.factor(pop3$age)
#这样做有问题，5-9岁年龄组错位。
levels(pop3$age)
#观察到5-9排在第10位，要调整到第2位。
#使用levels函数来纠正因子排序
levels(pop3$age) <- levels(pop3$age)[c(1, 10, 2:9, 11:length(levels(pop3$age)))]


#先做2017年的人口金字塔图
# 利用subset()抽取2017年的数据
pop2017 <- subset(pop3, year==2017)

# 利用subset()做分性别的条形图，然后旋转坐标轴。
# 利用aex(y=per*(-1))做对称轴。
# 利用scale_y_continuous()和abs()将负值标签调整为正。 
ggplot(data=pop2017, aes(x=age, y=per, fill=sex)) +
  geom_bar(data = subset(pop2017, sex=="女"), stat="identity") +
  geom_bar(data = subset(pop2017,sex=="男"), aes(y=per*(-1)), stat="identity") +
  scale_y_continuous(breaks = seq(-5,5,1), labels=abs(seq(-5, 5,1))) +
  coord_flip()

Rplot16.png

• 年龄段中5-9岁因子排序问题另一种解决方案

pop4 <-  filter(pop2, age!="总体")

# 先提取出age唯一值
age3 <- unique(pop4$age)
age3
# 然后按原字符顺序转成因子变量
age4 <- factor(1:20, labels=age3)
age4
# 最后，按age4的排序赋给数据集pop4中的age变量
pop4$age <- factor(pop4$age, levels=age4)
pop4$age


# 重新作图
pop2017 <- subset(pop4, year==2017)

ggplot(data=pop2017, aes(x=age, y=per, fill=sex)) +
  geom_bar(data = subset(pop2017, sex=="女"), stat="identity") +
  geom_bar(data = subset(pop2017,sex=="男"), aes(y=per*(-1)), stat="identity") +
  scale_y_continuous(breaks = seq(-6,6,1), labels=abs(seq(-6, 6,1))) +
  labs(x=NULL, y=NULL, title = "2017年中国人口金字塔\n", fill="", caption = "数据来源：国家统计局\n制作：wintryheart") +
  theme(plot.title = element_text(hjust=0.5), legend.position = c(.9, .9), legend.background = element_blank())+
  coord_flip()

Rplot17.png

利用gganimate包制做历年人口金字塔动图

1. 调用 transition_time()函数制作动图。
2. 调用{fram_time}，在标题中显示对应时间（年份）。
3. 由于动图中时间点是带小数位的，用 round()取整，确保标题中年份显示时为整数。

ggplot(data=pop3, aes(x=age, y=per, fill=sex)) +
  geom_bar(data=subset(pop3, sex=="女"), stat="identity") +
  geom_bar(data = subset(pop3,sex=="男"), aes(y=per*(-1)), stat="identity") +
  scale_y_continuous(breaks = seq(-5,5,1), labels=abs(seq(-5, 5,1))) +
  labs(x=NULL, y=NULL, title = "中国人口金字塔: {round(frame_time)}\n", fill="", caption = "数据来源：国家统计局\n制作：wintryheart") +
  theme(plot.title = element_text(hjust=0.5), legend.position = c(.9, .9), legend.background = element_blank())+
  coord_flip() +
  transition_time(year)

filefe464637466.gif

参考帖子：

• 使用R用动图展示日本老龄化
• ggplot2中更简单的人口金字塔
• 动态人口结构金字塔变化图
• R语言可视化：使用ggplot2绘制人口金字塔
• gganimate包说明