今天推文的主要内容来自于链接 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、生物信息学入门学习资料及自己的学习笔记！
