基于GBD数据绘图之——双Y轴图

寻小宁

已于 2023-10-30 16:52:07 修改

阅读量1.4k

点赞数 4

分类专栏：可视化文章标签： 1024程序员节

于 2023-10-24 17:15:31 首次发布

本文链接：https://blog.csdn.net/weixin_46579654/article/details/134015080

版权

可视化专栏收录该内容

5 篇文章

订阅专栏

GBD简介

GBD数据库由美国华盛顿大学健康测量和评价研究中心（ Institute for Health Metrics and Evaluation ，IHME ）的全球疾病负担（ GBD ）项目研究组牵头建立，提供了自 1990 年以来全球 204 个国家和地区的 369种疾病、伤害和健康危险因素的流行病学数据，并定期对数据库进行更新发布。近期对疾病负担研究颇感兴趣，在日常监测数据中也会经常用到，查阅了一系列paper，发现一张精美的图片，能将分析数据完美、直观的展示。本期文章就GBD数据进行双Y轴图的绘制。

GBD官网界面

注册下载数据

数据展示

双Y轴图绘制

本次展示以GBD2019数据库中中国2019年结直肠癌分性别、年龄组发病数据为基础，绘制发病数和发病率的双Y轴图。具体代码如下：

分步详细代码

载入软件包

rm(list = ls())
setwd("f://gbd绘图")

##载入所需软件包##
library(ggplot2)
library(RColorBrewer)
library(ggpubr)  
library(readxl)
library(reshape2)
library(dplyr)
library(tidyr)

数据整理

注：此处采取了两种方式对数据进行转换，也是对之前写的一篇长宽数据转换的文章进行了复习。

##读取数据##
data1<-read.csv("IHME-GBD_2019_DATA-281b0303-1.csv")##GBD2019中获取中国结直肠癌发病数据##

##数据整理##
##————————————————方式一（应用tidyr包中unite/spread/gatherh函数）##
za<-select(data1,6,8,12:16)%>%gather(class,value,names(data1)[14:16])%>%unite(met_name,metric_name,class,sep="_")%>%spread(met_name,value = value)

##————————————————方式二（应用reshape2中melt和dcast函数）##
za<-select(data1,6,8,12:16)%>%melt(id=c("sex_name","age_name","year","metric_name"),variable.name="class",value.name="value")%>%dcast(sex_name+age_name+year~metric_name+class)

绘图前变量因子化

##绘图前分类变量因子化##
h=c("Both","Male","Female")#自定义顺序#
za$sex_name<-factor(za$sex_name,level=h)
za<-za[order(za$sex_name),]##按照上边定义的顺序排序##
m=c("0-14 years","15-49 years","50-69 years","70+ years")
za$age_name<-factor(za$age_name,level=m)
za<-za[order(za$age_name),]##按照上边定义的顺序排序##
coeff=max(za$Number_upper)/max(za$Rate_upper)%>%round()#coeff=第一个Y轴最大值除以第二个Y轴最大值#

绘制双Y轴图

绘制双坐标轴图主要利用sec.axis()函数，具体用法可参考help文档。

p=ggplot(za, aes(x =age_name))+#总的控制#
  geom_errorbar(aes(ymin=Number_val, ymax=Number_upper,group=sex_name,color=sex_name),position=position_dodge(0.25), width=.15,size=0.3,alpha=0.5)+#画误差线图，dodge和width宽度最好和条形图宽度一样,size是设置误差线的宽度#
  geom_bar(aes(y=Number_val,group=sex_name,fill=sex_name), stat="identity",position = "dodge",width = 0.25,alpha=0.5)+#画条形图，width可以设置条形图宽度#
  geom_line(aes(y=Rate_val*coeff,group=sex_name,color=sex_name),size=0.8)+#画第二条Y轴的线图#
  geom_point(aes(y=Rate_val*coeff,group=sex_name,color=sex_name,shape=sex_name),size=2)+#画第二条Y轴的线图#
  geom_errorbar(aes(ymin=Rate_lower*coeff, ymax=Rate_upper*coeff,group=sex_name,color=sex_name), width=.05,size=0.4)+#画误差线图，dodge和width宽度最好和条形图宽度一样,size是设置误差线的宽度#
  scale_fill_manual(values=c("blue","red","gray" ),labels=c("Male (Deaths number)","Female (Deaths number)","Both (Deaths number)"))+#设置填充颜色和标签#
  scale_color_manual(values=c("blue","red","gray" ),labels=c("Male (Deaths number)","Female (Deaths number)","Both (Deaths number)"))+#设置线的颜色和标签#
  scale_shape_manual(values=c(2,4,8),labels=c("Male (Death rate)","Female (Death rate)","Both (Death rate)"))+#设置线的颜色和标签#
  theme_classic()+#主题#
  theme(axis.text.x=element_text(angle = 45,hjust=0.5,vjust=0.5,color="black",size=12),
        axis.text.y=element_text(color="black",size=12),
        axis.title.x = element_text(size=12),
        axis.title.y = element_text(size=12),legend.title =element_blank(),
        legend.position="top",
        legend.spacing.y = unit(0.5, "cm"),legend.text=element_text(size=8))+#设置字体颜色#
  scale_y_continuous(breaks=seq(0,200000,50000),labels=c("0","50,000","100,000","150,000","200,000"),expand=c(0,0),limits = c(0,200000),
                     sec.axis = sec_axis(~./coeff,name="Death rate (per 100,000)"))+#设置y轴刻度及标签#
  labs(y="Death number",x="Age")+#设置xy轴的标题#
  guides(fill=guide_legend(nrow=3,ncol = 1))+####设置填充和颜色图例的位置
  guides(shape=guide_legend(nrow=3,ncol=1))####设置形状图例的位置
print(p)
ggsave('双Y轴图.JPEG',plot=p, dpi=600, width=12, height=7)