跟着Nat Commun学作图 | 1.批量箱线图+散点+差异分析

今天要复现的图来自2021年 7月的一篇Nature Communication，又是一篇新冠的跨组学文章。今天先来复现其中的一幅箱线图。

Snipaste_2021-11-01_23-02-28

DOI:10.1038/s41467-021-24482-1

前言

Snipaste_2021-11-01_23-15-09

关于此类箱线图在之前的文章(跟着 Cell 学作图 | 3.箱线图+散点+差异显著性检验)里已经讲过了，今天主要是多了一个批量的绘制。因为这篇文献公布了部分代码(https://github.com/DongshengChen-TY/COVID19)，所以这篇推文就以这个代码为蓝本，进行一定的简化。所谓，一千个人里有一千个哈姆雷特，同样的分析往往会有不同的思路。读别人代码是一个提升自己语言能力的一个很好的办法，如果能够取其精华、为己所用就最好不过了。

示例数据及作图前准备

基因表达矩阵

image-20211101232623699

样本分组信息

image-20211101232804026

数据处理

# 导入数据并添加分组信息
mRNA<-read.csv("All_mRNA_FPKM.csv",header=T,row.names=1)
exp<-log2(mRNA+1)
bar_mat<-t(exp)
anno<-read.csv("sample_index.csv",header=T,row.names=1)
anno$type2<-anno$Type
anno <- anno[rownames(bar_mat),]
bar_mat<-bar_mat[rownames(anno),]
bar_mat<-as.data.frame(bar_mat)
bar_mat$sam=anno$Type

绘制

library(RColorBrewer)
library(ggpubr)
library(ggplot2)
# 因子水平
bar_mat$sam<-factor(bar_mat$sam,levels=c("Asymptomatic","Mild","Severe","Critical"))
# 颜色、分组比较设置
color <-c("#5CB85C","#337AB7","#F0AD4E","#D9534F")
my_comparisons <- list(c("Asymptomatic", "Mild"),
                       c("Asymptomatic", "Severe"),
                       c("Asymptomatic", "Critical"),
                       c("Mild", "Severe"),
                       c("Mild", "Critical"),
                       c("Severe", "Critical"))

循环部分

# 提取需要循环绘制的基因名
gc <- colnames(bar_mat)
#开始批量绘制
plist<-list()
for (i in 1:length(gc)){
  bar_tmp<-bar_mat[,c(gc[i],"sam")]
  colnames(bar_tmp)<-c("Expression","sam")
  pb1<-ggboxplot(bar_tmp,
                 x="sam",
                 y="Expression",
                 color="sam",
                 fill=NULL,
                 add = "jitter",
                 bxp.errorbar.width = 0.6,
                 width = 0.4,
                 size=0.01,
                 font.label = list(size=30), 
                 palette = color)+
    theme(panel.background =element_blank())
  pb1<-pb1+theme(axis.line=element_line(colour="black"))+theme(axis.title.x = element_blank())
  pb1<-pb1+theme(axis.title.y = element_blank())+theme(axis.text.x = element_text(size = 15,angle = 45,vjust = 1,hjust = 1))
  pb1<-pb1+theme(axis.text.y = element_text(size = 15))+ggtitle(gc[i])+theme(plot.title = element_text(hjust = 0.5,size=15,face="bold"))
  pb1<-pb1+theme(legend.position = "NA")
  pb1<-pb1+stat_compare_means(method="t.test",hide.ns = F,comparisons =my_comparisons,label="p.signif")
  plist[[i]]<-pb1
}

合并拼图

library(cowplot)
pall<-plot_grid(plist[[1]],plist[[2]],plist[[3]],
                plist[[4]],plist[[5]],plist[[6]],
                plist[[7]],plist[[8]],plist[[9]],
                plist[[10]],plist[[11]],plist[[12]],plist[[13]],plist[[14]],
                plist[[15]],plist[[16]],plist[[17]],plist[[18]],
                plist[[19]],plist[[20]],plist[[21]],
                plist[[22]],plist[[23]],plist[[24]],
                plist[[25]],plist[[26]],ncol=5)
pall