Follow PNAS to learn to draw: the stacked column chart of the R language ggplot2 facet, a bit similar to the one showing the group structure k

paper

https://www.pnas.org/content/118/20/e2010588118 Death rates at specific life stages mold the sex gap in life expectancy

image.png

Paper local storagee2010588118.full.pdf

A very interesting paper, the research content is why girls live longer than men (Why do women live longer than men?) Hahaha. But I haven't understood the whole paper, so I won't introduce the conclusion to you first.

The data and code of this paper are public, and the link is https://github.com/CPop-SDU/sex-gap-e0-pnas. We try to restore the graph in the paper according to the code and data provided by him. Today's tweet repeats Figure 1A in the paper

image.png

Stacked Column Chart

I began to think that this picture was made by jigsaw puzzles. After reading his drawing code, I found that it was realized by faceting.

Colors ready for drawing


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

Load the required R package

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

Load dataset

load("data/a6gap33cntrs.rda")

Organize the dataset into the format required for ggplot2 plotting

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)

The datasets used in the final mapping are as follows

drawing code

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)

The final result is as follows

You can download the sample data and code yourself from the github link mentioned at the beginning, or you can directly leave a message in the background of the official account 20210907(the message needs to match exactly at the beginning and end without spaces)

Welcome everyone to pay attention to my public number

Xiao Ming's data analysis notebook

Xiaoming’s data analysis notebook public account mainly shares: 1. Simple examples of R language and python for data analysis and data visualization; 2. Reading notes on horticultural plants related transcriptomics, genomics, and population genetics literature; 3. Bioinformatics Learn introductory study materials and your own study notes!


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

{{o.name}}
{{m.name}}

Guess you like

Origin my.oschina.net/u/4579431/blog/5254800
Recommended