跟着Nature学作图:R语言ggplot2环形堆积柱形图完整示例

普通网友

493人浏览 · 2025-12-05 13:29:19

普通网友 · 2025-12-05 13:29:19 发布

论文

A global reptile assessment highlights shared conservation needs of tetrapods

https://www.nature.com/articles/s41586-022-04664-7#Sec33

数据代码链接

https://github.com/j-marin/Global-reptile-assessment-

今天的推文学习一下推文中的Figure 1b的环形堆积柱形图，没有找到论文中的作图代码，但是找到了原始数据集，有了原始数据集就可以自己写代码来做这个图

image.png

代码可以参考这个链接 https://r-graph-gallery.com/297-circular-barplot-with-groups.html

部分示例数据截图

image.png

每个组之间的空白应该是通过缺失值实现的

读取数据

library(readxl)
dat01<-read_excel("data/20220630/41586_2022_4664_MOESM3_ESM.xlsx",
                  sheet = "Fig 1b",na="NA")
head(dat01)

给数据集增加一列用来做x

library(tidyverse)
dat01 %>% 
  mutate(new_x = rep(paste0('X',formatC(1:31,width = 2,flag = 0)),each=8)) -> dat01

最基本的堆积柱形图

library(ggplot2)
ggplot(data = dat01,aes(x=new_x,y=n,fill=rlCodes))+
  geom_bar(stat = "identity",position = "fill")

这里有一个问题是论文中的图第一个柱子不是1,暂时没有想明白是什么意思

这里有点看起来是分组堆积柱形图的效果，ggplot2好像没有做分组堆积柱形图的函数，他这里的处理方式是增加x，并给新增加的x赋值为零

变成环状

ggplot(data = dat01,aes(x=new_x,y=n,fill=rlCodes))+
  geom_bar(stat = "identity",position = "fill")+
  coord_polar()+
  ylim(-1,NA)

接下来是修改细节

ggplot(data = dat01,aes(x=new_x,y=n,fill=rlCodes))+
  geom_bar(stat = "identity",position = "fill")+
  coord_polar()+
  scale_x_discrete(expand = expansion(add = 0),
                   labels=coalesce(dat01$orderName[seq(1,248,8)],""))+
  scale_y_continuous(limits = c(-1,NA))+
  theme(axis.text.x = element_text(angle = cumsum(c(90,-rep(12,15))),
                                   vjust=0,hjust = 1),
        panel.background = element_blank(),
        axis.text.y = element_blank(),
        axis.title = element_blank(),
        axis.ticks = element_blank())-> p1
p1

p1 + 
  annotate(geom = "text",x=2,y=-0.1,label="Birds",angle=-15)+
  annotate(geom = "text",x=8,y=-0.1,label="Amphibians",angle=-90)+
  annotate(geom = "text",x=14,y=-0.1,label="Mammals",angle=15)+
  annotate(geom = "text",x=24,y=-0.1,label="Reptiles",angle=90)+
  scale_fill_manual(values = c("LC"="#98d09d","NT"="#d7e698",
                               "DD"="#dadada","VU"="#fbf398",
                               "EN"="#f7a895","CR"="#e77381",
                               "EW"="#9b8191","EX"="#8f888b"),
                    limits=c("EX","EW","CR","EN","VU","DD","NT","LC"),
                    name="") -> p2
p2

构造新的数据集用来添加坐标轴

new_dat01<-data.frame(
  x=0.5,xend=0.3,
  y=c(0,0.25,0.5,0.75,1),
  yend=c(0,0.25,0.5,0.75,1)
)
new_dat02<-data.frame(x=0.3,
                      y=c(0,0.25,0.5,0.75,1),
                      label=c(0,0.25,0.5,0.75,1)*100)

p2 + annotate(geom = "segment",
           x=0.5,xend=0.5,y=0,yend=1)+
  geom_segment(data=new_dat01,
               aes(x=x,xend=xend,y=y,yend=yend),
               inherit.aes = FALSE)+
  geom_text(data=new_dat02,aes(x=x,y=y,label=label),
            inherit.aes = FALSE,hjust=1)+
  annotate(geom = "text",x=30,y=0.5,label="Species\nthreatened (%)",
           angle=90,vjust=-0.1)

拼图

library(patchwork)

library(rcartocolor)

p3+
  scale_fill_manual(values = carto_pal(8,"Safe"))+
  theme(legend.position = "bottom")+
  guides(fill=guide_legend(nrow = 1))+
  p3+
  theme(legend.position = "bottom")+
  guides(fill=guide_legend(nrow = 1))