跟着Environmental Research学作图：R语言ggplot2堆积柱形图叠加折线图（2）

用户7010445

发布于 2022-04-08 13:43:19

1.8K0

发布于 2022-04-08 13:43:19

论文是

Global burden of lung cancer attributable to ambient fine particulate matter pollution in 204 countries and territories, 1990–2019

image.png

一位公众号读者留言问到下图的实现方法

image.png

这个图涉及到3个知识点

一个是堆积柱形图
一个是两条折线图之间填充颜色
还有一个是双坐标轴的实现办法

这三个知识点分成2期推文分别来介绍，今天的推文是第二期，介绍带置信区间的折线图和双Y轴

堆积柱形图的代码

library(ggplot2)
library(readxl)

dat01<-read_excel("example-1.xlsx",
                  sheet = "Sheet1")


ggplot()+
  geom_bar(data=dat01,
           aes(x=x,y=y1,fill=group),
           position = "stack",
           stat="identity")+
  scale_fill_manual(values = c("#2271b6","#6bafd6",
                               "#9ecbe2","#d7e3ef",
                               "#cb181c","#fb6a4b",
                               "#fd9272","#fee1d3"))+
  theme_bw()+
  labs(x="Age",y="Numbers of deaths")+
  scale_y_continuous(breaks = seq(-35000,35000,5000),
                     labels = abs(seq(-35000,35000,5000)))+
  scale_x_continuous(breaks = 1:15,
                     labels = unique(dat01$xlabel),
                     expand = c(0,0),
                     limits = c(0.3,15.7))

image.png

带置信区间的折线图

这里置信区间是提前算好的

数据

image.png

dat02<-read_excel("example-1.xlsx",
                  sheet = "Sheet2")
dat02

ggplot()+
  geom_ribbon(data=dat02,
              aes(x=x,ymin=y1,ymax=y3,
                  fill=group,color=group),
              alpha=0.5)+
  geom_line(data=dat02,
            aes(x=x,y=y2,
                color=group),
            show.legend = FALSE)+
  scale_fill_manual(values = c("#2271b6","#cb181c"))+
  scale_color_manual(values = c("#2271b6","#cb181c"))+
  theme_bw()

image.png

堆积柱形图和折线图叠加到一起

因为两组数据量级不一样，我们需要对其中一个数据集进行转化，这里我们选择将折线图的数据放大

dat01 %>% 
  filter(group=="A") %>% 
  group_by(xlabel) %>% 
  summarise(y=sum(y1)) -> dat01.a

dat01 %>% 
  filter(group=="B") %>% 
  group_by(xlabel) %>% 
  summarise(y=sum(y1)) -> dat01.b
dat01.b

dat02 %>% 
  filter(group=="A") -> dat02.a

newdat.a<-data.frame(y=dat01.a$y,
                     x=dat02.a$y2)
lm(y~x,data=newdat.a)

对原始数据转化

dat02 %>% 
  mutate(across(c(y1,y2,y3),~.x*100-1000)) -> new.dat02

最后是作图代码

ggplot()+
  geom_bar(data=dat01,
           aes(x=x,y=y1,fill=group),
           position = "stack",
           stat="identity")+
  scale_fill_manual(values = c("#2271b6","#6bafd6",
                               "#9ecbe2","#d7e3ef",
                               "#cb181c","#fb6a4b",
                               "#fd9272","#fee1d3"),
                    name="BBB")+
  theme_bw()+
  labs(x="Age",y="Numbers of deaths")+
  scale_y_continuous(breaks = seq(-35000,35000,5000),
                     labels = abs(seq(-35000,35000,5000)),
                     sec.axis = sec_axis(~(.+1000)/100,
                                         name="Mortality Rate per 1000",
                                         breaks = seq(-400,400,40)))+
  scale_x_continuous(breaks = 1:15,
                     labels = unique(dat01$xlabel),
                     expand = c(0,0),
                     limits = c(0.3,15.7))+
  ggnewscale::new_scale_fill()+
  geom_ribbon(data=new.dat02,
              aes(x=x,ymin=y1,ymax=y3,
                  fill=group,color=group),
              alpha=0.2)+
  geom_line(data=new.dat02,
            aes(x=x,y=y2,
                color=group),
            show.legend = FALSE)+
  scale_fill_manual(values = c("#00b0eb","#e20612"),
                    name="AAA")+
  scale_color_manual(values = c("#2271b6","#cb181c"),
                     name="AAA")+
  theme_bw()