[GBD数据库挖掘2] ggplot2优雅的展示发病率

❝本节继续来进行GBD数据库的挖掘，小编在去年写过代码的基础上进行了更加精细的加工，各位观众老爷们细细品味，「数据代码已经上传VIP群，请自行下载」

加载R包

代码语言：javascript复制

library(tidyverse)
library(ggh4x)
library(ggsci)
library(magrittr)
library(grid)

导入数据

代码语言：javascript复制

df <- read_csv("liver_cancer.csv")

数据清洗

代码语言：javascript复制

df1 <- df %>% select(measure,year,val,location,age,metric,sex) %>% 
  filter(location %in% c("Global","High SDI",
                         "High-middle SDI","Middle SDI",
                         "Low-middle SDI","Low SDI"),
         age == 'Age-standardized',metric=="Rate",measure !="Prevalence") %>%
  select(measure,val,location,year,sex) %>% 
  mutate(measure=case_when(measure=="DALYs (Disability-Adjusted Life Years)" ~ 
                             "DALYs per 100,000",
                           TRUE ~ as.character(measure))) %>% 
  mutate(across("measure",str_replace,"Deaths","ASDR per 100,000")) %>% 
  mutate(across("measure",str_replace,"Incidence","ASIR per 100,000")) %>% 
  mutate(val=as.numeric(val),year=as.numeric(year),sex=as.factor(sex)) %>% 
  unite(.,col="measure",sex,measure,sep="-",remove = T,na.rm = F)

定义因子

代码语言：javascript复制

df1$measure <- factor(df1$measure,levels=c("Both-ASIR per 100,000","Both-ASDR per 100,000",
                                          "Both-DALYs per 100,000",
                                          "Female-ASIR per 100,000","Female-ASDR per 100,000",
                                          "Female-DALYs per 100,000",
                                          "Male-ASIR per 100,000","Male-ASDR per 100,000",
                                          "Male-DALYs per 100,000"))

定义分面背景

代码语言：javascript复制

ridiculous_strips <- strip_themed(
  text_x = elem_list_text(colour=c("#9C8D58","#EDB749","#3CB2EC"),
                          face=c("bold","bold","bold"),size=c(10,10,10)),
  background_x = elem_list_rect(fill = c("#EEECE1","#FFF2E7","#E8F2FC")))

定义注释函数

代码语言：javascript复制

annotation_custom2 <- function (grob, xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = Inf, data) 
{
  layer(data = data, stat = StatIdentity, position = PositionIdentity, 
        geom = ggplot2:::GeomCustomAnn,
        inherit.aes = TRUE, params = list(grob = grob, 
                                          xmin = xmin, xmax = xmax, 
                                          ymin = ymin, ymax = ymax))
}

数据可视化

代码语言：javascript复制

df1 %>% ggplot(aes(year,val,color=location,fill=location)) 
  geom_point(size=2,pch=21,color="white") geom_line() 
  facet_wrap2(vars(measure),scales = "free_y",axes = "y",remove_labels = "x",strip = ridiculous_strips) 
  guides(color=guide_legend(title="location",nrow=1)) 
  scale_color_jco() 
  scale_fill_jco() 
  coord_cartesian(clip="off") 
  theme_bw() 
  theme(panel.spacing.x = unit(0.1,"cm"),
        panel.spacing.y = unit(0.15,"cm"),
        axis.title = element_blank(),
        strip.background = element_rect(fill="grey80"),
        strip.text.x = element_text(size=9,color="black"),
        axis.text = element_text(color="black"),
        plot.margin=unit(c(0.2,0.5,0.2,0.2),units=,"cm"),
        legend.text=element_text(color="black",size=9,face="bold"),
        legend.key=element_blank(),  
        legend.title = element_blank(),
        legend.position = "top",
        legend.spacing.x=unit(0.1,'cm'),
        legend.key.width=unit(0.5,'cm'),
        legend.key.height=unit(0.5,'cm'), 
        legend.background=element_blank()) 
  annotation_custom2(grob = rectGrob(gp = gpar(fill="grey90",col="black")),
                     data = df1 %>% filter(measure=="Both-ASDR per 100,000"),
                     xmin =1954.5,xmax =2055.5,ymin=18.5,ymax=20)

结果保存

代码语言：javascript复制

ggsave("Figure-1.pdf",width=11.79,height=10.42,units="in",dpi=300)

数据获取

❝好的本文介绍到此介绍，相信看过相关文档的都很了解具体内容，小编也不过多阐述了；

数据可视化

0 人点赞