跟着PNAS学画图：R语言ggplot2分面的堆积柱形图

论文

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

堆积柱形图

我开始以为这个图是采用拼图的方式做的，看完他的作图代码发现是通过分面实现的

准备作图的配色

pal_six <- c(
  "#084488", # [0, 1)
  "#3FB3F7", # [1,15)
  "#003737", # [15,40)
  "#268A8A", # [40,60)
  "#eec21f", # [60,80)
  "#A14500" # [80,111)
)


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)]

加载需要的R包

library(ggplot2)
library(tidyverse)
library(magrittr)

加载数据集

load("data/a6gap33cntrs.rda")

将数据集整理为ggplot2作图需要的格式

df6 %>% 
  filter(country %>% magrittr::is_in(c("SWE", "USA", "JPN", "RUS"))) %>%
  mutate(
    name = name %>% 
      fct_recode(USA = "United States") %>% 
      fct_rev()
  ) -> df6.0
head(df6.0)

最终作图用到的数据集如下

image.png

画图代码

df6.0 %>% 
  ggplot() +
  geom_col(
    aes(year, ctb_rel %>% multiply_by(100), fill = age_group),
    position = position_stack(reverse = TRUE),
    color = NA,
    width = 1
  ) +
  facet_grid(name ~ ., scales = "free_y", space = "free") +
  coord_cartesian(ylim = c(-10, 120), expand = FALSE)+
  scale_x_continuous(breaks = seq(1800, 2000, 50))+
  scale_y_continuous(breaks = seq(0, 100, 25), position = "right")+
  scale_fill_manual(
    values = pal_six, 
    guide  = guide_legend(ncol = 1, reverse = TRUE)
  ) +
  theme_minimal(base_family = font_rc, base_size = 20) +
  theme(
    legend.position = c(.6, .5),
    strip.background = element_blank(),
    strip.text = element_blank(),
    panel.grid.minor =  element_blank(),
    panel.grid.major =  element_line(size = .1),
    panel.spacing = unit(0, "lines"),
    panel.ontop = T
  )+
  labs(x = NULL,
       y = "Contribution, %",
       fill = "Age group")+
  # label countries
  geom_text(data = . %>% select(name, row, column) %>%  distinct(),
            aes(label = name, color = name), 
            x = 2015, y = 120, 
            hjust = 1, vjust = 1, size = 9, fontface = 2,
            family = font_rc)+
  scale_color_manual(values = pal_four %>% rev, 
                     guide = FALSE)

最终结果如下

image.png

示例数据和代码大家可以自己到开头提到的github链接去下载，也可以直接在公众号后台留言20210907获取 （留言需要精确匹配开头结尾都不能有空格）

欢迎大家关注我的公众号

小明的数据分析笔记本

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