論文
https://www.pnas.org/content/118/20/e2010588118
Death rates at specific life stages mold the sex gap in life expectancy
論文本地存儲(chǔ) e2010588118.full.pdf
很有意思的一篇論文囚聚，研究的內(nèi)容是為什么女生比男生活的時(shí)間長(zhǎng)（Why do women live longer than men?）哈哈哈蚁廓。但是整篇論文我還沒有看明白添瓷，所以先不給大家介紹結(jié)論了。
這篇論文的數(shù)據(jù)和代碼是公開的损拢，鏈接是 https://github.com/CPop-SDU/sex-gap-e0-pnas，我們按照他提供的代碼和數(shù)據(jù)試著復(fù)原一下論文里的圖。今天的推文重復(fù)的內(nèi)容是論文中的Figure1A
堆積柱形圖
我開始以為這個(gè)圖是采用拼圖的方式做的窄锅，看完他的作圖代碼發(fā)現(xiàn)是通過分面實(shí)現(xiàn)的
準(zhǔn)備作圖的配色
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)
加載數(shù)據(jù)集
load("data/a6gap33cntrs.rda")
將數(shù)據(jù)集整理為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)
最終作圖用到的數(shù)據(jù)集如下
畫圖代碼
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)
最終結(jié)果如下
示例數(shù)據(jù)和代碼大家可以自己到開頭提到的github鏈接去下載，也可以直接在公眾號(hào)后臺(tái)留言20210907獲取 （留言需要精確匹配開頭結(jié)尾都不能有空格）
歡迎大家關(guān)注我的公眾號(hào)
小明的數(shù)據(jù)分析筆記本
小明的數(shù)據(jù)分析筆記本 公眾號(hào) 主要分享：1缰雇、R語言和python做數(shù)據(jù)分析和數(shù)據(jù)可視化的簡(jiǎn)單小例子入偷；2、園藝植物相關(guān)轉(zhuǎn)錄組學(xué)械哟、基因組學(xué)盯串、群體遺傳學(xué)文獻(xiàn)閱讀筆記；3戒良、生物信息學(xué)入門學(xué)習(xí)資料及自己的學(xué)習(xí)筆記体捏！
