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

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

部分示例数据如下

image.png

• 第一列是年份 （年份是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()

image.png

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

我们再来看下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()

image.png

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

接下来我们把每个年份都只做一张图，然后做成一个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/

Webp.net-gifmaker.gif

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

欢迎大家关注我的公众号

小明的数据分析笔记本

留言讨论相关内容

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

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