R语言ggplot2画金字塔图展示人口结构

今天推文的主要内容来自于链接 https://ikashnitsky.github.io/2017/who-is-old/。本来是计划完全重复这个教程的，但是教程中的数据已经不可以下载了，所以按照教程中的数据来源找到了瑞典的人口数据，大家可以自己下载这个数据集，下载链接是 https://www.mortality.org/ ，这个需要一个简单的注册，当然也可以在公众号后台留言 20210826获取今天推文的示例数据和代码（留言需要精准匹配，开头结尾不能有空格，不知道之前的留言为什么经常会出现空格）。

部分示例数据如下

第一列是年份（年份是1751年到2020年）
第二列是年龄
第三列是女生人数
第四列是男生人数
第五列是总数

首先我们挑选1751年的数据做一个金字塔图

加载作图包

library(tidyverse)
library(ggplot2)
library(see)

读取数据；挑选1751年的数据；并计算不同年龄男女分别占总人口的比例并将宽格式数据转换为长格式数据

df <- read_tsv("20210826/20210826-1.txt")
#write_tsv(df,file = "20210826/20210826-1.txt")
head(df)

df %>% filter(Year == 1751) %>% 
  mutate(FP = Female/sum(Total),
         MP = - Male/sum(Total)) %>% 
  select(Age,FP,MP) %>% 
  reshape2::melt(id.vars="Age",
                 variable.name="Sex",
                 value.name = "prop") -> df1

作图

df1 %>% 
  ggplot()+
  geom_col(aes(x=Age,y=prop,fill=Sex),
           width = 1)+
  scale_y_continuous(breaks = c(-.01, 0, .01), 
                     labels = c(.01, 0, .01),
                     limits = c(-.02, .02), 
                     expand = c(0,0))+
  theme_minimal()+
  theme(legend.position = "none",
        panel.grid = element_blank(),
        plot.title = element_text(hjust = 0.5, size = 20))+
  coord_flip()+
  labs(x=NULL,y=NULL,title = "1751")+
  annotate(geom="text",
           y=-0.01,x=100,
           label="Male")+
  annotate(geom="text",
           y=0.01,x=100,
           label="Female")+
  scale_fill_material_d()

我们看到这个人口结构还是笔记符合金字塔的结构的

我们再来看下2020年的数据

df %>% filter(Year == 2020) %>% 
  mutate(FP = Female/sum(Total),
         MP = - Male/sum(Total)) %>% 
  select(Age,FP,MP) %>% 
  reshape2::melt(id.vars="Age",
                 variable.name="Sex",
                 value.name = "prop") %>% 
  ggplot()+
  geom_col(aes(x=Age,y=prop,fill=Sex),
           width = 1)+
  scale_y_continuous(breaks = c(-.01, 0, .01), 
                     labels = c(.01, 0, .01),
                     limits = c(-.02, .02), 
                     expand = c(0,0))+
  theme_minimal()+
  theme(legend.position = "none",
        panel.grid = element_blank(),
        plot.title = element_text(hjust = 0.5, size = 20))+
  coord_flip()+
  labs(x=NULL,y=NULL,title = "2020")+
  annotate(geom="text",
           y=-0.01,x=100,
           label="Male")+
  annotate(geom="text",
           y=0.01,x=100,
           label="Female")+
  scale_fill_material_d()

从上图可以看出依然是塔形，但是已经从埃及金字塔变成了我国的古佛塔了！

接下来我们把每个年份都只做一张图，然后做成一个gif

作图代码

years<-unique(df$Year)

figures <- list()

for (i in seq(1,length(years),10)){
  df %>% filter(Year == years[i]) %>% 
    mutate(FP = Female/sum(Total),
           MP = - Male/sum(Total)) %>% 
    select(Age,FP,MP) %>% 
    reshape2::melt(id.vars="Age",
                   variable.name="Sex",
                   value.name = "prop") %>% 
    ggplot()+
    geom_col(aes(x=Age,y=prop,fill=Sex),
             width = 1)+
    scale_y_continuous(breaks = c(-.01, 0, .01), 
                       labels = c(.01, 0, .01),
                       limits = c(-.02, .02), 
                       expand = c(0,0))+
    theme_minimal()+
    theme(legend.position = "none",
          panel.grid = element_blank(),
          plot.title = element_text(hjust = 0.5, size = 20))+
    coord_flip()+
    labs(x=NULL,y=NULL,title = years[i])+
    annotate(geom="text",
             y=-0.01,x=100,
             label="Male")+
    annotate(geom="text",
             y=0.01,x=100,
             label="Female")+
    scale_fill_material_d() -> gg
  figures[[i]] <- gg
}


for (i in seq(1,length(years),10)){
  ggsave(paste0('20210826/swe-', 
                years[i], '.png'), 
         figures[[i]], 
         width = 8, 
         height = 5.6)
}

只做gif用到在像工具 https://gifmaker.me/

今天的内容就就介绍这么多

欢迎大家关注我的公众号

小明的数据分析笔记本

留言讨论相关内容

今天推文的示例数据和代码可以在公众号后台留言回复20210826获取

小明的数据分析笔记本公众号主要分享：1、R语言和python做数据分析和数据可视化的简单小例子；2、园艺植物相关转录组学、基因组学、群体遗传学文献阅读笔记；3、生物信息学入门学习资料及自己的学习笔记！

本文分享自微信公众号 - 小明的数据分析笔记本（gh_0c8895f349d3）。
如有侵权，请联系 [email protected] 删除。
本文参与“OSC源创计划”，欢迎正在阅读的你也加入，一起分享。