大数跨境
0
0

ggplot2绘制进阶版物种组成图

ggplot2绘制进阶版物种组成图 R语言数据分析指南
2021-05-03
1
导读:之前写过一些微生物多样性后续的可视化文档,感觉当时水平有限写的一般般没什么新意,今天重新来进行一下数据可视化

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

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())
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")
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)

图片拼接

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

往期精彩:

配置R与Rstudio
ggplot2中的一些关键概念
tidyverse的基础使用
ggplot2绘制终极版热图
ggtree绘制进化树
初探相关性热图
再探相关性热图
ggplot2绘制相关性热图
初探柱状图
绘制具有显著性的条形图
ggplo2绘制经典条形图
ggplo2绘制双误差线条行图
揭开ggplot2中stat图层的神秘面纱
R中的图片注释神包aplot
ggplot2使用patchwork高质量拼图
ggplot2绘制基础散点图
ggplot2绘制经典散点图-1
ggplot2绘制经典散点图-2
ggplot2绘制云雨图
ggplot2绘制经典云雨图
ggplot2绘制哑铃图
ggplot2绘制经典哑铃图
ggplot2添加gif


【声明】内容源于网络
0
0
R语言数据分析指南
R语言重症爱好者,喜欢绘制各种精美的图表,喜欢的小伙伴可以关注我,跟我一起学习
内容 1180
粉丝 0
R语言数据分析指南 R语言重症爱好者,喜欢绘制各种精美的图表,喜欢的小伙伴可以关注我,跟我一起学习
总阅读410
粉丝0
内容1.2k