跟着PNAS学画图:R语言ggplot2分组添加拟合曲线

原创
2021/08/29 17:04
阅读数 575

论文

https://www.pnas.org/content/118/20/e2010588118 

Death rates at specific life stages mold the sex gap in life expectancy

image.png

论文本地存储 e2010588118.full.pdf

很有意思的一篇论文,研究的内容是为什么女生比男生活的时间长(Why do women live longer than men?)哈哈哈。但是整篇论文我还没有看明白,所以先不给大家介绍结论了。

这篇论文的数据和代码是公开的,链接是 https://github.com/CPop-SDU/sex-gap-e0-pnas,我们按照他提供的代码和数据试着复原一下论文里的图。今天的推文重复的内容是论文中的Figure1A

image.png

分组折线图

用到的数据集是链接里的dat文件夹下的 df4qx.rda文件,

首选是导入数据

load("data/df4qx.rda")
head(df4qx)
image.png

这个是一个长格式数据,把它转变成宽格式

#install.packages("tidyverse")
library(tidyverse)
df4qx %>% 
  pivot_wider(names_from = sex,values_from = qx) %>% 
  head()
image.png

这一步是为了方便计算不同年龄男女死亡率的比例

ggplot2作图

df4qx %>% 
  pivot_wider(names_from = sex,values_from = qx) -> dftemp

最基本的图

library(ggplot2)
dftemp %>% 
  ggplot(aes(age,y=m/f,color=country))+
  geom_smooth(se=F,size=1,color="#ffffff",span=0.25)+
  geom_smooth(se = F, size = .5, span = .25)+
  theme_minimal(base_size = 16)
image.png

这里原始代码还设置字体了,我这里就跳过了,因为我的电脑没有这个字体

接下来做细节调整

添加一条水平辅助线
dftemp %>% 
  ggplot(aes(age,y=m/f,color=country))+
  geom_smooth(se=F,size=1,color="#ffffff",span=0.25)+
  geom_smooth(se = F, size = .5, span = .25)+
  theme_minimal(base_size = 16,base_family = "serif")+
  geom_hline(yintercept = 1, color = "gray25",  size = .5)
image.png
更改x轴刻度范围
dftemp %>% 
  ggplot(aes(age,y=m/f,color=country))+
  geom_smooth(se=F,size=1,color="#ffffff",span=0.25)+
  geom_smooth(se = F, size = .5, span = .25)+
  theme_minimal(base_size = 16,base_family = "serif")+
  geom_hline(yintercept = 1, color = "gray25",  size = .5)+
  scale_x_continuous(breaks = c(0, 15, 40, 60, 80))
image.png
对y轴进行log2转换
dftemp %>% 
  ggplot(aes(age,y=m/f,color=country))+
  geom_smooth(se=F,size=1,color="#ffffff",span=0.25)+
  geom_smooth(se = F, size = .5, span = .25)+
  theme_minimal(base_size = 16,base_family = "serif")+
  geom_hline(yintercept = 1, color = "gray25",  size = .5)+
  scale_x_continuous(breaks = c(0, 15, 40, 60, 80))+
  scale_y_continuous(
  trans = "log"
  breaks = c(.5, 1, 2, 3), 
  labels = c("", 1, 2, 3),
  limits = c(.75, 3.5))
image.png

这一步为啥要做转化呢 有些没看明白

自定义配色
pal_safe_five <- c(
  "#eec21f"# default R 4.0 yellow
  "#009C9C"# light shade of teal: no red, equal green and blue
  "#df356b"# default R 4.0 red
  "#08479A"# blues9[8] "#08519C" made a bit darker
  "#003737" # very dark shade of teal
)

pal_safe_five_ordered <- pal_safe_five[c(5,2,1,3,4)]
pal_four <- pal_safe_five_ordered[c(2,5,3,4)]

dftemp %>% 
  ggplot(aes(age,y=m/f,color=country))+
  geom_smooth(se=F,size=1,color="#ffffff",span=0.25)+
  geom_smooth(se = F, size = .5, span = .25)+
  theme_minimal(base_size = 16,base_family = "serif")+
  geom_hline(yintercept = 1, color = "gray25",  size = .5)+
  scale_x_continuous(breaks = c(0, 15, 40, 60, 80))+
  scale_y_continuous(
    trans = "log"
    breaks = c(.5, 1, 2, 3), 
    labels = c("", 1, 2, 3),
    limits = c(.75, 3.5))+
  scale_color_manual(NULL, values = pal_four)
image.png
添加文本注释
dftemp %>% 
  ggplot(aes(age,y=m/f,color=country))+
  geom_smooth(se=F,size=1,color="#ffffff",span=0.25)+
  geom_smooth(se = F, size = .5, span = .25)+
  theme_minimal(base_size = 16,base_family = "serif")+
  geom_hline(yintercept = 1, color = "gray25",  size = .5)+
  scale_x_continuous(breaks = c(0, 15, 40, 60, 80))+
  scale_y_continuous(
    trans = "log"
    breaks = c(.5, 1, 2, 3), 
    labels = c("", 1, 2, 3),
    limits = c(.75, 3.5))+
  scale_color_manual(NULL, values = pal_four)+
  annotate(
    "text", x = 50, y = .9, 
    label = "Most recent year",
    size = 8.5, color = "grey50", alpha = .5,
    vjust = 1, family = "serif", fontface = 2
  )
image.png
去掉图例并更改坐标轴标题
dftemp %>% 
  ggplot(aes(age,y=m/f,color=country))+
  geom_smooth(se=F,size=1,color="#ffffff",span=0.25)+
  geom_smooth(se = F, size = .5, span = .25)+
  theme_minimal(base_size = 16,base_family = "serif")+
  geom_hline(yintercept = 1, color = "gray25",  size = .5)+
  scale_x_continuous(breaks = c(0, 15, 40, 60, 80))+
  scale_y_continuous(
    trans = "log"
    breaks = c(.5, 1, 2, 3), 
    labels = c("", 1, 2, 3),
    limits = c(.75, 3.5))+
  scale_color_manual(NULL, values = pal_four)+
  annotate(
    "text", x = 50, y = .9, 
    label = "Most recent year",
    size = 8.5, color = "grey50", alpha = .5,
    vjust = 1, family = "serif", fontface = 2
  )+
  theme(
    legend.position = "none",
    panel.grid.minor = element_blank()
  )+
  labs(
    y = "Sex ratio, log scale",
    x = "Age"
  )
image.png

欢迎大家关注我的公众号

小明的数据分析笔记本

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

(精确匹配开头结尾都不能有空格)

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

后记

今天发现视频号和公众号现在可以带货了,京东和拼多多平台的商品可以生成我自己的链接,如果有人通过这个链接购买商品 我就可以得到相应比例的佣金。比如我今天买了两双鞋,总共花费400多,我拿到的佣金是20几块。大家如果经常在京东或者拼多多买东西的话可以加一下下面的微信群,比如你想买一件东西,可以先把商品的链接发给我,我生成我专属的链接,然后你再通过我的专属链接买,这样我就能有收入,我可以将收入的一半再转给你,你能省几块钱,我也能赚几块钱。

abb7fbb212f4b30dcc85b8e5bae6d18.png


本文分享自微信公众号 - 小明的数据分析笔记本(gh_0c8895f349d3)。
如有侵权,请联系 support@oschina.cn 删除。
本文参与“OSC源创计划”,欢迎正在阅读的你也加入,一起分享。

展开阅读全文
加载中
点击引领话题📣 发布并加入讨论🔥
0 评论
0 收藏
0
分享
返回顶部
顶部