ggplot2绘制进阶版物种组成图

之前写过一些微生物多样性的后续可视化的文档，感觉当时水平有限写的一般般没什么新意，今天重新来进行一下数据可视化分析，绘制一张更加富有美感的物种组成图，喜欢的小伙伴可以加入的我交流群获取文档数据及代码

library(tidyverse)
library(scales)
library(ggh4x)
library(patchwork)
library(magrittr)

computed_persent <- function(path) {
  data <- path %>%
    read.delim(check.names = F,sep="\t",row.names = 1) %>% 
    t() %>% as.data.frame()
  data2 <- data %>%
    mutate(sum = rowSums(.), persent = sum / sum(sum) * 100, 
           sum = NULL,) %>%
    rbind(filter(., persent < 0.1) %>% colSums()) %>%
    mutate(Taxa = c(data %>% rownames(), "others"))
  filter(data2[1:(nrow(data2) - 1),], persent > 0.1) %>%
    rbind(data2[nrow(data2),]) %>%
    select(ncol(.), 1:(ncol(.) - 2)) %>%
    set_rownames(seq_len(nrow(.))) %>%
    return()
}

otu_taxa <- computed_persent("otu.xls") %>% 
  pivot_longer(cols = !Taxa,names_to = "Samples",
               values_to = "number") %>% arrange(desc(number))

meta_taxa <- read.delim("taxa.xls",check.names = F,sep="\t") %>% 
  inner_join(.,otu_taxa,,by="Samples")

meta_taxa$Taxa <- factor(meta_taxa$Taxa,levels = unique(meta_taxa$Taxa))

palette <-c("#00545b","#ff856d","#640025","#3ddda5","#cdffaa","#150e00","#bae278",
            "#007a98","#ffe093","#00533f","#90f0ff","#6d3c00","#004f17")

p1 <- ggplot(meta_taxa,aes(Samples,ReadCount,fill=Group))+
  geom_col(width = 0.9)+theme_grey()+
  labs(y="Read Abundance", x=NULL)+
  scale_fill_manual(values=c("light blue", "dark red"))+
  facet_nested(.~Type,drop=TRUE,scale="free",space="free")+
  scale_y_continuous(expand = c(0,0),
                     labels=scales::scientific_format(digits=1))+
  theme(strip.text = element_blank(),
        axis.ticks.x = element_blank(),
        panel.background = element_rect(fill='white'),
        panel.spacing = unit(0.01,"lines"),
        axis.text.y=element_text(size=12),
        axis.title.y = element_text(size=12,color="black"),
        axis.text.x = element_blank())

image

p2 <- ggplot(meta_taxa,aes(Samples,number,fill=Taxa))+
  geom_col(position="stack") +
  facet_nested(.~Type+Trial+Day,drop=T,
               scale="free",space="free",switch="x")+
  scale_fill_manual(values=palette)+
  labs(x=NULL, y="Percent Phyla Abundance")+
  scale_y_continuous(expand = c(0,0),labels=scales::percent)+
  theme(strip.background = element_rect(fill="white",color="black"),
        panel.spacing = unit(0,"lines"),
        strip.text.x = element_text(size=12,color="black"),
        axis.text.y=element_text(size=12),
        axis.title.y = element_text(size=12,color="black"),
        axis.text.x = element_blank(),
        axis.ticks.x = element_blank())+
  labs(fill="Phylum")

image

g <- ggplot_gtable(ggplot_build(p2))

strips <- which(grepl('strip-', g$layout$name))

pal <- c("#E64B35FF","#4DBBD5FF","#00A087FF","#3C5488FF","#F39B7FFF","#8491B4FF","#91D1C2FF",
         "#FF0000","#4DBBD5FF","#00A087FF","#3C5488FF","#F39B7FFF","#8491B4FF","#91D1C2FF",
         "#F8AFA8","#4DBBD5FF","#B09C85FF","#3C5488FF","#F39B7FFF","#B09C85FF","#91D1C2FF",
         "#D3DDDC","#00A087FF","#E6A0C4","#3C5488FF")

for (i in seq_along(strips)) {
  k <- which(grepl('rect', g$grobs[[strips[i]]]$grobs[[1]]$childrenOrder))
  l <- which(grepl('titleGrob', g$grobs[[strips[i]]]$grobs[[1]]$childrenOrder))
  g$grobs[[strips[i]]]$grobs[[1]]$children[[k]]$gp$fill <- pal[i]
  # g$grobs[[strips[i]]]$grobs[[1]]$children[[l]]$children[[1]]$gp$col <- pal[i] #设置字体颜色
}

plot(g)

image

图片拼接

image

由于一些个人无法解决的问题，此处用了AI进行拼图