博文
R语言一键批量完成差异统计和可视化
||
[toc]
撰文：文涛 南京农大
责编：刘永鑫 中科院遗传发育所
R语言一键完成差异检测从数据到展示
单因素差异分析的完整方案
关键词：正态性检验；方差齐性；非参数检验；秩和检验；多重比较；带显著性字母柱状图或箱线图
由于作者水平有限，大家可以添加我的个人微信讨论细节、bug和可改进的地方（微信号：nanjingxuezi）
方案优点
这份方案有一下几个特征，在展示之前给大家mark一下
- 完整的差异分析思路及其R语言实现
提供两种可视化方案：柱状图和箱线图；差异结果使用两种表示方法：字母进行排序表示，或者两组之间连线。
可视化图形标注方差齐性结果，正态性检验结果等
- 自动识别数据指标，自动保存分析结果，文件名称标记分析指标及其分析操作内容和方式。
引子
记得从2016年入学以来，老板叫做的第一个分析便是单因素方差分析,对R 来讲也就是一个aov函数。单因素方差分析确实在很多情况下确实是大多数人的需求，基于R语言的实现也很简单。但是做完之后我便是被吐槽，没有正态性检验，没有方差齐性检验，于是之后的一天，就做了一个简单流程，当时发布在我的个人公众号：微生信生物：《R语言绘制带有显著性字母标记的柱状图》； 内容是：首先QQ图，方差齐性检验，后又做了aov和多重比较。并写了个简单的循环。大家可以看到明显不够完整。今天我来的目的就是完善单因素方差分析并且在不适合方差分析的情况下的非参数检验也加入方案中，其次可视化也做了一个完善。（大家有想法的留言，我将加在本框架内，完善差异检测方案）
那么为什么选在这样一个日子来完善这样一份代码呢？刘老师NBT上线不久，其中fig6让我很是怀念之前使用R语言出带显著性标记的柱状图。于是才有了今天可视化方案中的planB。当然刘老师亲自做的NBT的分析值得我逐行运行，尤其是其中的物种分类的GraPhlan，算是到目前为止，我见过的最为漂亮的物种分类树。相信刘老师在之后的文章解读部分会为大家详细解读。
我结合之前的工作同时结合刘老师的工作，设计了一个这样的思路：试图方便自己的工作，同时希望帮到大家。
单因素差异检测完整方案实现思路
试验中经常测定的指标共同的特征是：不同的处理，有重复，需要做差异检测。因此这里我首先对数据进行正态性检验和方差齐性检验，判断符合后进行多重比较并选择喜欢的可视化方案（这里我提供了两种可视化方法，分别是：柱状图，箱线图），判断不符合后，进行非参数检验，首先进行kruskal.test检验（同时对多组进行差异检验），如果有差异，我将继续进行Wilcoxon秩和检验，之后便选择两种可视化方案中的一种进行可视化。
我写了一个骨架：
主要函数解读
两种差异表示方案及其代码
下面是进行LSD多重比较及其添加表征差异的字母柱状图代码：
#值得注意的是LSD多重比较输出的就是字母形式的结果，如果我们选择其他多重比较方法，注意提取差异显著字母格式的结果
out <- LSD.test(model,"group", p.adj="none")#进行多重比较
aa = out$group#结果显示：标记字母法
aa$group = row.names(aa)
wen1 = as.data.frame(tapply(dd,data_wt$group,mean,na.rm=TRUE))
wen2 = as.data.frame(tapply(dd,data_wt$group,sd,na.rm=TRUE))
went = cbind(wen1,wen2)
wentao = merge(aa,went, by="row.names",all=F)
colnames(wentao) = c(colnames(wentao[1:4]),"mean" ,"SD")
aa = mutate(wentao, ymin = mean - SD, ymax = mean + SD)
a = max(aa$mean)*1.2
# ss <- round(wtx3$`Pr(>F)`[1],3)
p = ggplot(aa , aes(x = group, y = mean,colour= group)) +
geom_bar(aes(colour= group,fill = group),stat = "identity", width = 0.4,position = "dodge") +
geom_text(aes(label = groups,y=ymax, x = group,vjust = -0.3,size = 6))+
geom_errorbar(aes(ymin=ymin,
ymax=ymax),
colour="black",width=0.1,size = 1)+
scale_y_continuous(expand = c(0,0),limits = c(0,a))+
labs(x=paste(name_i,"of all group", sep = "_"),
y="group",
title = paste("Normality test",p1,"Homogeneity of variance",p2,"kruskal.test",sumkrusk[3],sep = ":"))
p
字母标记箱线图代码
这部分代码来源自刘老师NBT（https://mp.weixin.qq.com/s/WumCJTcEYLLmywKxzJPumg） 中的fig6，也正是这份代码，让我产生了重新升级差异分析的念头。说句题外话，刘老师的代码书写思路我总有一种亲切的感觉。
out <- LSD.test(model,"group", p.adj="none")
aa = out$group
aa$group = row.names(aa)
a = max(aa$dd)*1.2
data_box = data_wt[c(1,2,i)]
colnames(data_box) = c("ID" , "group","dd" )
stat = out$groups
data_box$stat=stat[as.character(data_box$group),]$groups
max=max(data_box[,c("dd")])
min=min(data_box[,c("dd")])
x = data_box[,c("group","dd")]
y = x %>% group_by(group) %>% summarise_(Max=paste('max(',"dd",')',sep=""))
y=as.data.frame(y)
rownames(y)=y$group
data_box$y=y[as.character(data_box$group),]$Max + (max-min)*0.05
p = ggplot(data_box, aes(x=group, y=data_box[["dd"]], color=group)) +
geom_boxplot(alpha=1, outlier.size=0, size=0.7, width=0.5, fill="transparent") +
labs(x=paste(name_i," group", sep = "_"),
y="group",
title = paste("Normality test",p1,"Homogeneity of variance",p2,sep = ":"))+
geom_text(data=data_box, aes(x=group, y=y, color=group, label= stat)) +
geom_jitter( position=position_jitter(0.17), size=1, alpha=0.7)+theme(legend.position="none")
p
if (length(unique(data_box$group))>3){ p=p+theme(axis.text.x=element_text(angle=45,vjust=1, hjust=1))}
FileName <- paste(name_i,"_aov_LSD_box", ".pdf", sep = "")
ggsave(FileName, p, width = 8, height = 8)
ggpubr + 箱线图 + 连线差异标注
由于两组之间的连线需要指定两组信息，这里我又想将所有组之间的差异展示出来，所以使用combn函数得到分组信息两两匹配的结果，并使用tapply结合函数将矩阵改变为列表。完成这一工作。
wtq = levels(data_wt$group)
lis = combn(levels(data_wt$group), 2)
x <-lis
my_comparisons <- tapply(x,rep(1:ncol(x),each=nrow(x)),function(i)i)p = ggplot(data_box, aes(x=group, y=data_box[["dd"]], color=group)) +
geom_boxplot(alpha=1, outlier.size=0, size=0.7, width=0.5, fill="transparent") +
labs(x=paste(name_i,"of all group", sep = "_"),
y="group",
title = paste("Normality test",p1,"Homogeneity of variance",p2,sep = ":"))+
# geom_text(data=data_box, aes(x=group, y=y, color=group, label= stat)) +
geom_jitter( position=position_jitter(0.17), size=1, alpha=0.7)+theme(legend.position="none")+
stat_compare_means()+
stat_compare_means(comparisons=my_comparisons,label = "p.signif",hide.ns = F) # Add pairwise
p
实战
测序数据和Rmd代码，后台回复“anova”获取。
导入需要的包
```{r pre analyse, echo=TRUE, message=FALSE, warning=FALSE, paged.print=FALSE}
site=”https://mirrors.tuna.tsinghua.edu.cn/CRAN“
install.packages(“tidyverse”, repo=site)
library(tidyverse)
library(agricolae)
library(car)
library(reshape2)
library(“ggplot2”)
library(“ggpubr”)
### 导入数据
这里的数据格式为宽格式，提供长格式到宽格式的转化
```{r imput data, echo=TRUE, message=FALSE, warning=FALSE, paged.print=FALSE}
# 读入实验设计
data_wt = read.table("./cs.txt", header=T, sep="\t");head(data_wt)
##数据由长变宽
data_wt = dcast(data_wt,ID +group ~ grou, value.var = "count")
#这里备注所需的数据格式
#前量列从第一列开始是ID，第二列是分组信息，剩下的列均为数据列
head(data_wt)选择可视化方案
plot = "bar"
plot = "box"运行函数
```{r function for main, echo=TRUE, message=FALSE, warning=FALSE, paged.print=FALSE}
for (i in 3:ncol(data_wt)) {
ss <- data_wt[i]
colnames(ss) <- c(“count”)
ssgroup
xx <- shapiro.test(ss$count)
p1 <- xx[[2]]
方差齐性检验
xc <- bartlett.test(count~group,data=ss)
p2 <- xc[[3]]
if ( plot == “bar”) {
if (p1 >.05& p2 >.05) {
p1 <- round(p1,3)
p2 <- round(p2,3)
data_i = data_wt[i]
ee <-as.matrix(data_i)
dd <- as.vector(ee)
name_i = colnames(data_wt[i])
model<-aov(dd ~ group, data=data_wt)#方差分析
wtx1 = summary(model)
wtx2 = wtx1[[1]]
wtx3 = wtx2[5]
if ( wtx3$`Pr(>F)`[1]< 0.05) {
out <- LSD.test(model,"group", p.adj="none")#进行多重比较，不矫正P值
aa = out$group#结果显示：标记字母法
aa$group = row.names(aa)
a = max(aa$dd)*1.2
aa
wen1 = as.data.frame(tapply(dd,data_wt$group,mean,na.rm=TRUE))
wen2 = as.data.frame(tapply(dd,data_wt$group,sd,na.rm=TRUE))
went = cbind(wen1,wen2)
wentao = merge(aa,went, by="row.names",all=F)
colnames(wentao) = c(colnames(wentao[1:4]),"mean" ,"SD")
aa = mutate(wentao, ymin = mean - SD, ymax = mean + SD)
mi=c("#1B9E77" ,"#D95F02", "#7570B3","#E7298A")
p = ggplot(aa , aes(x = group, y = dd,colour= group)) +
geom_bar(aes(colour= group,fill = group),stat = "identity", width = 0.4,position = "dodge") +
geom_text(aes(label = groups,y=ymax, x = group,vjust = -0.3,size = 6))+
geom_errorbar(aes(ymin=ymin,
ymax=ymax),
colour="black",width=0.1,size = 1)+
scale_y_continuous(expand = c(0,0),limits = c(0,a))+
labs(x=paste(name_i,"of all group", sep = "_"),
y="group",
title = paste("Normality test",p1,"Homogeneity of variance",p2,sep = ":"))
p
p=p+theme_bw()+
geom_hline(aes(yintercept=mean(dd)), colour="black", linetype=2) +
geom_vline(aes(xintercept=0), colour="black", linetype="dashed") +
# scale_fill_manual(values = mi, guide = guide_legend(title = NULL))+
theme(
panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),
plot.title = element_text(vjust = -8.5,hjust = 0.1),
axis.title.y =element_text(size = 20,face = "bold",colour = "black"),
axis.title.x =element_text(size = 24,face = "bold",colour = "black"),
axis.text = element_text(size = 20,face = "bold"),
axis.text.x = element_text(colour = "black",size = 14),
axis.text.y = element_text(colour = "black",size = 14),
legend.text = element_text(size = 15,face = "bold"),
legend.position = "none"#是否删除图例
)
p
FileName <- paste(name_i,"_aov_LSD_bar", ".pdf", sep = "_")
ggsave(FileName, p, width = 8, height = 8)
}else if ( wtx3$`Pr(>F)`[1]>= 0.05) {
out <- LSD.test(model,"group", p.adj="none")#进行多重比较，不矫正P值
aa = out$group#结果显示：标记字母法
aa$group = row.names(aa)
a = max(aa$dd)*1.2
wen1 = as.data.frame(tapply(dd,data_wt$group,mean,na.rm=TRUE))
wen2 = as.data.frame(tapply(dd,data_wt$group,sd,na.rm=TRUE))
went = cbind(wen1,wen2)
wentao = merge(aa,went, by="row.names",all=F)
colnames(wentao) = c(colnames(wentao[1:4]),"mean" ,"SD")
aa = mutate(wentao, ymin = mean - SD, ymax = mean + SD)
ss <- round(wtx3$`Pr(>F)`[1],3)
mi=c("#1B9E77" ,"#D95F02", "#7570B3","#E7298A")
p = ggplot(aa , aes(x = group, y = dd,colour= group)) +
geom_bar(aes(colour= group,fill = group),stat = "identity", width = 0.4,position = "dodge") +
# geom_text(aes(label = groups,y=ymax, x = group,vjust = -0.3,size = 6))+
geom_errorbar(aes(ymin=ymin,
ymax=ymax),
colour="black",width=0.1,size = 1)+
scale_y_continuous(expand = c(0,0),limits = c(0,a))+
labs(x=paste(name_i,"of all group", sep = "_"),
y="group",
title = paste("Normality test",p1,"Homogeneity of variance",p2,"aov",ss,sep = ":"))
p
p=p+theme_bw()+
geom_hline(aes(yintercept=mean(dd)), colour="black", linetype=2) +
geom_vline(aes(xintercept=0), colour="black", linetype="dashed") +
# scale_fill_manual(values = mi, guide = guide_legend(title = NULL))+
theme(
panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),
plot.title = element_text(vjust = -8.5,hjust = 0.1),
axis.title.y =element_text(size = 20,face = "bold",colour = "black"),
axis.title.x =element_text(size = 24,face = "bold",colour = "black"),
axis.text = element_text(size = 20,face = "bold"),
axis.text.x = element_text(colour = "black",size = 14),
axis.text.y = element_text(colour = "black",size = 14),
legend.text = element_text(size = 15,face = "bold"),
legend.position = "none"#是否删除图例
)
p
FileName <- paste(name_i,"aov_nosig"," bar", ".pdf", sep = "_")
ggsave(FileName, p, width = 8, height = 8)
}
}else if (p1 <.05| p2 <.05){
p1 <- round(p1,3)
p2 <- round(p2,3)
data_i = data_wt[i]
ee <-as.matrix(data_i)
dd <- as.vector(ee)
name_i = colnames(data_wt[i])
xax = data.frame(dd = dd,group = data_wt$group)
krusk=compare_means(dd ~ group, data=xax, method = "kruskal.test")
sumkrusk=as.data.frame(krusk)
if ( sumkrusk[3]< 0.05) {
out <- LSD.test(model,"group", p.adj="none")#进行多重比较，不矫正P值
aa = out$group#结果显示：标记字母法
aa$group = row.names(aa)
out <- LSD.test(model,"group", p.adj="none")#进行多重比较，不矫正P值
aa = out$group#结果显示：标记字母法
aa$group = row.names(aa)
aa
wen1 = as.data.frame(tapply(dd,data_wt$group,mean,na.rm=TRUE))
wen2 = as.data.frame(tapply(dd,data_wt$group,sd,na.rm=TRUE))
went = cbind(wen1,wen2)
wentao = merge(aa,went, by="row.names",all=F)
colnames(wentao) = c(colnames(wentao[1:4]),"mean" ,"SD")
aa = mutate(wentao, ymin = mean - SD, ymax = mean + SD)
a = max(aa$mean)*1.2
# ss <- round(wtx3$`Pr(>F)`[1],3)
mi=c("#1B9E77" ,"#D95F02", "#7570B3","#E7298A")
p = ggplot(aa , aes(x = group, y = mean,colour= group)) +
geom_bar(aes(colour= group,fill = group),stat = "identity", width = 0.4,position = "dodge") +
# geom_text(aes(label = groups,y=ymax, x = group,vjust = -0.3,size = 6))+
geom_errorbar(aes(ymin=ymin,
ymax=ymax),
colour="black",width=0.1,size = 1)+
scale_y_continuous(expand = c(0,0),limits = c(0,a))+
labs(x=paste(name_i,"of all group", sep = "_"),
y="group",
title = paste("Normality test",p1,"Homogeneity of variance",p2,"kruskal.test",sumkrusk[3],sep = ":"))
p
p=p+theme_bw()+
geom_hline(aes(yintercept=mean(dd)), colour="black", linetype=2) +
geom_vline(aes(xintercept=0), colour="black", linetype="dashed") +
# scale_fill_manual(values = mi, guide = guide_legend(title = NULL))+
theme(
panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),
plot.title = element_text(vjust = -8.5,hjust = 0.1),
axis.title.y =element_text(size = 20,face = "bold",colour = "black"),
axis.title.x =element_text(size = 24,face = "bold",colour = "black"),
axis.text = element_text(size = 20,face = "bold"),
axis.text.x = element_text(colour = "black",size = 14),
axis.text.y = element_text(colour = "black",size = 14),
legend.text = element_text(size = 15,face = "bold"),
legend.position = "none"#是否删除图例
)
p
FileName <- paste(name_i,"_kruskal.test_YES_bar", ".pdf", sep = "_")
ggsave(FileName, p, width = 8, height = 8)
}else if ( sumkrusk[3] >= 0.05) {
out <- LSD.test(model,"group", p.adj="none")#进行多重比较，不矫正P值
aa = out$group#结果显示：标记字母法
aa$group = row.names(aa)
aa
wen1 = as.data.frame(tapply(dd,data_wt$group,mean,na.rm=TRUE))
wen2 = as.data.frame(tapply(dd,data_wt$group,sd,na.rm=TRUE))
went = cbind(wen1,wen2)
wentao = merge(aa,went, by="row.names",all=F)
colnames(wentao) = c(colnames(wentao[1:4]),"mean" ,"SD")
aa = mutate(wentao, ymin = mean - SD, ymax = mean + SD)
a = max(aa$mean)*1.2
# ss <- round(wtx3$`Pr(>F)`[1],3)
mi=c("#1B9E77" ,"#D95F02", "#7570B3","#E7298A")
p = ggplot(aa , aes(x = group, y = mean,colour= group)) +
geom_bar(aes(colour= group,fill = group),stat = "identity", width = 0.4,position = "dodge") +
# geom_text(aes(label = groups,y=ymax, x = group,vjust = -0.3,size = 6))+
geom_errorbar(aes(ymin=ymin,
ymax=ymax),
colour="black",width=0.1,size = 1)+
scale_y_continuous(expand = c(0,0),limits = c(0,a))+
labs(x=paste(name_i,"of all group", sep = "_"),
y="group",
title = paste("Normality test",p1,"Homogeneity of variance",p2,"kruskal.test",sumkrusk[3],sep = ":"))
p
p=p+theme_bw()+
geom_hline(aes(yintercept=mean(mean)), colour="black", linetype=2) +
geom_vline(aes(xintercept=0), colour="black", linetype="dashed") +
# scale_fill_manual(values = mi, guide = guide_legend(title = NULL))+
theme(
panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),
plot.title = element_text(vjust = -8.5,hjust = 0.1),
axis.title.y =element_text(size = 20,face = "bold",colour = "black"),
axis.title.x =element_text(size = 24,face = "bold",colour = "black"),
axis.text = element_text(size = 20,face = "bold"),
axis.text.x = element_text(colour = "black",size = 14),
axis.text.y = element_text(colour = "black",size = 14),
legend.text = element_text(size = 15,face = "bold"),
legend.position = "none"#是否删除图例
)
p
FileName <- paste(name_i,"_kruskal.test_nosig_bar", ".pdf", sep = "")
ggsave(FileName, p, width = 8, height = 8)
}
}}else if( plot == “box”) {
if (p1 >.05& p2 >.05) {
p1 <- round(p1,3)
p2 <- round(p2,3)
data_i = data_wt[i]
ee <-as.matrix(data_i)
dd <- as.vector(ee)
name_i = colnames(data_wt[i])
model<-aov(dd ~ group, data=data_wt)#方差分析
wtx1 = summary(model)
wtx2 = wtx1[[1]]
wtx3 = wtx2[5]
if ( wtx3$`Pr(>F)`[1]< 0.05) {
out <- LSD.test(model,"group", p.adj="none")#进行多重比较，不矫正P值
aa = out$group#结果显示：标记字母法
aa$group = row.names(aa)
a = max(aa$dd)*1.2
data_box = data_wt[c(1,2,i)]
colnames(data_box) = c("ID" , "group","dd" )
out = LSD.test(model,"group", p.adj="none") # alternative fdr
stat = out$groups
data_box$stat=stat[as.character(data_box$group),]$groups
max=max(data_box[,c("dd")])
min=min(data_box[,c("dd")])
x = data_box[,c("group","dd")]
y = x %>% group_by(group) %>% summarise_(Max=paste('max(',"dd",')',sep=""))
y=as.data.frame(y)
rownames(y)=y$group
data_box$y=y[as.character(data_box$group),]$Max + (max-min)*0.05
# mi=c("#1B9E77" ,"#D95F02", "#7570B3","#E7298A")
p = ggplot(data_box, aes(x=group, y=data_box[["dd"]], color=group)) +
geom_boxplot(alpha=1, outlier.size=0, size=0.7, width=0.5, fill="transparent") +
labs(x=paste(name_i," group", sep = "_"),
y="group",
title = paste("Normality test",p1,"Homogeneity of variance",p2,sep = ":"))+
geom_text(data=data_box, aes(x=group, y=y, color=group, label= stat)) +
geom_jitter( position=position_jitter(0.17), size=1, alpha=0.7)+theme(legend.position="none")
p
p=p+theme_bw()+
geom_hline(aes(yintercept=mean(dd)), colour="black", linetype=2) +
geom_vline(aes(xintercept=0), colour="black", linetype="dashed") +
# scale_fill_manual(values = mi, guide = guide_legend(title = NULL))+
theme(
panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),
plot.title = element_text(vjust = -8.5,hjust = 0.1),
axis.title.y =element_text(size = 20,face = "bold",colour = "black"),
axis.title.x =element_text(size = 24,face = "bold",colour = "black"),
axis.text = element_text(size = 20,face = "bold"),
axis.text.x = element_text(colour = "black",size = 14),
axis.text.y = element_text(colour = "black",size = 14),
legend.text = element_text(size = 15,face = "bold"),
legend.position = "none"#是否删除图例
)
p
if (length(unique(data_box$group))>3){ p=p+theme(axis.text.x=element_text(angle=45,vjust=1, hjust=1))}
FileName <- paste(name_i,"_aov_LSD_box", ".pdf", sep = "")
ggsave(FileName, p, width = 8, height = 8)
}else if ( wtx3$`Pr(>F)`[1]>= 0.05) {
out <- LSD.test(model,"group", p.adj="none")#进行多重比较，不矫正P值
aa = out$group#结果显示：标记字母法
aa$group = row.names(aa)
a = max(aa$dd)*1.2
data_box = data_wt[c(1,2,i)]
colnames(data_box) = c("ID" , "group","dd" )
out = LSD.test(model,"group", p.adj="none") # alternative fdr
stat = out$groups
data_box$stat=stat[as.character(data_box$group),]$groups
max=max(data_box[,c("dd")])
min=min(data_box[,c("dd")])
x = data_box[,c("group","dd")]
y = x %>% group_by(group) %>% summarise_(Max=paste('max(',"dd",')',sep=""))
y=as.data.frame(y)
rownames(y)=y$group
data_box$y=y[as.character(data_box$group),]$Max + (max-min)*0.05
ss <- round(wtx3$`Pr(>F)`[1],3)
# mi=c("#1B9E77" ,"#D95F02", "#7570B3","#E7298A")
p = ggplot(data_box, aes(x=group, y=data_box[["dd"]], color=group)) +
geom_boxplot(alpha=1, outlier.size=0, size=0.7, width=0.5, fill="transparent") +
labs(x=paste(name_i,"box", sep = "_"),
y="group",
title = paste("Normality test",p1,"Homogeneity of variance",p2,"aov",ss,sep = ":"))+
# geom_text(data=data_box, aes(x=group, y=y, color=group, label= stat)) +
geom_jitter( position=position_jitter(0.17), size=1, alpha=0.7)+theme(legend.position="none")
p
p=p+theme_bw()+
geom_hline(aes(yintercept=mean(dd)), colour="black", linetype=2) +
geom_vline(aes(xintercept=0), colour="black", linetype="dashed") +
# scale_fill_manual(values = mi, guide = guide_legend(title = NULL))+
theme(
panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),
plot.title = element_text(vjust = -8.5,hjust = 0.1),
axis.title.y =element_text(size = 20,face = "bold",colour = "black"),
axis.title.x =element_text(size = 24,face = "bold",colour = "black"),
axis.text = element_text(size = 20,face = "bold"),
axis.text.x = element_text(colour = "black",size = 14),
axis.text.y = element_text(colour = "black",size = 14),
legend.text = element_text(size = 15,face = "bold"),
legend.position = "none"#是否删除图例
)
p
if (length(unique(data_box$group))>3){ p=p+theme(axis.text.x=element_text(angle=45,vjust=1, hjust=1))}
FileName <- paste(name_i,"_aov_nosig_box", ".pdf", sep = "")
ggsave(FileName, p, width = 8, height = 8)
}
}else if (p1 <.05| p2 <.05){
p1 <- round(p1,3)
p2 <- round(p2,3)
data_i = data_wt[i]
ee <-as.matrix(data_i)
dd <- as.vector(ee)
name_i = colnames(data_wt[i])
xax = data.frame(dd = dd,group = data_wt$group)
krusk=compare_means(dd ~ group, data=xax, method = "kruskal.test")
sumkrusk=as.data.frame(krusk)
if ( sumkrusk[3]< 0.05) {
out <- LSD.test(model,"group", p.adj="none")#进行多重比较，不矫正P值
aa = out$group#结果显示：标记字母法
aa$group = row.names(aa)
a = max(aa$dd)*1.2
data_box = data_wt[c(1,2,i)]
colnames(data_box) = c("ID" , "group","dd" )
out = LSD.test(model,"group", p.adj="none") # alternative fdr
stat = out$groups
data_box$stat=stat[as.character(data_box$group),]$groups
max=max(data_box[,c("dd")])
min=min(data_box[,c("dd")])
x = data_box[,c("group","dd")]
y = x %>% group_by(group) %>% summarise_(Max=paste('max(',"dd",')',sep=""))
y=as.data.frame(y)
rownames(y)=y$group
data_box$y=y[as.character(data_box$group),]$Max + (max-min)*0.05
# mi=c("#1B9E77" ,"#D95F02", "#7570B3","#E7298A")
wtq = levels(data_wt$group)
lis = combn(levels(data_wt$group), 2)
x <-lis
my_comparisons <- tapply(x,rep(1:ncol(x),each=nrow(x)),function(i)i)
p = ggplot(data_box, aes(x=group, y=data_box[["dd"]], color=group)) +
geom_boxplot(alpha=1, outlier.size=0, size=0.7, width=0.5, fill="transparent") +
labs(x=paste(name_i,"of all group", sep = "_"),
y="group",
title = paste("Normality test",p1,"Homogeneity of variance",p2,sep = ":"))+
# geom_text(data=data_box, aes(x=group, y=y, color=group, label= stat)) +
geom_jitter( position=position_jitter(0.17), size=1, alpha=0.7)+theme(legend.position="none")+
stat_compare_means()+
stat_compare_means(comparisons=my_comparisons,label = "p.signif",hide.ns = F) # Add pairwise
p
p=p+theme_bw()+
geom_hline(aes(yintercept=mean(dd)), colour="black", linetype=2) +
geom_vline(aes(xintercept=0), colour="black", linetype="dashed") +
# scale_fill_manual(values = mi, guide = guide_legend(title = NULL))+
theme(
panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),
plot.title = element_text(vjust = -8.5,hjust = 0.1),
axis.title.y =element_text(size = 20,face = "bold",colour = "black"),
axis.title.x =element_text(size = 24,face = "bold",colour = "black"),
axis.text = element_text(size = 20,face = "bold"),
axis.text.x = element_text(colour = "black",size = 14),
axis.text.y = element_text(colour = "black",size = 14),
legend.text = element_text(size = 15,face = "bold"),
legend.position = "none"#是否删除图例
)
p
if (length(unique(data_box$group))>3){ p=p+theme(axis.text.x=element_text(angle=45,vjust=1, hjust=1))}
FileName <- paste(name_i,"_kruskal.test_wlc_box_", ".pdf", sep = "")
ggsave(FileName, p, width = 8, height = 8)
}else if ( sumkrusk[3] >= 0.05) {
out <- LSD.test(model,"group", p.adj="none")#进行多重比较，不矫正P值
aa = out$group#结果显示：标记字母法
aa$group = row.names(aa)
a = max(aa$dd)*1.2
data_box = data_wt[c(1,2,i)]
colnames(data_box) = c("ID" , "group","dd" )
out = LSD.test(model,"group", p.adj="none") # alternative fdr
stat = out$groups
data_box$stat=stat[as.character(data_box$group),]$groups
max=max(data_box[,c("dd")])
min=min(data_box[,c("dd")])
x = data_box[,c("group","dd")]
y = x %>% group_by(group) %>% summarise_(Max=paste('max(',"dd",')',sep=""))
y=as.data.frame(y)
rownames(y)=y$group
data_box$y=y[as.character(data_box$group),]$Max + (max-min)*0.05
ss <- round(wtx3$`Pr(>F)`[1],3)
# mi=c("#1B9E77" ,"#D95F02", "#7570B3","#E7298A")
p = ggplot(data_box, aes(x=group, y=data_box[["dd"]], color=group)) +
geom_boxplot(alpha=1, outlier.size=0, size=0.7, width=0.5, fill="transparent") +
labs(x=paste(name_i,"box", sep = "_"),
y="group",
title = paste("Normality test",p1,"Homogeneity of variance",p2,"aov",ss,sep = ":"))+
# geom_text(data=data_box, aes(x=group, y=y, color=group, label= stat)) +
geom_jitter( position=position_jitter(0.17), size=1, alpha=0.7)+theme(legend.position="none")+
stat_compare_means()
p
p=p+theme_bw()+
geom_hline(aes(yintercept=mean(dd)), colour="black", linetype=2) +
geom_vline(aes(xintercept=0), colour="black", linetype="dashed") +
# scale_fill_manual(values = mi, guide = guide_legend(title = NULL))+
theme(
panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),
plot.title = element_text(vjust = -8.5,hjust = 0.1),
axis.title.y =element_text(size = 20,face = "bold",colour = "black"),
axis.title.x =element_text(size = 24,face = "bold",colour = "black"),
axis.text = element_text(size = 20,face = "bold"),
axis.text.x = element_text(colour = "black",size = 14),
axis.text.y = element_text(colour = "black",size = 14),
legend.text = element_text(size = 15,face = "bold"),
legend.position = "none"#是否删除图例
)
p
if (length(unique(data_box$group))>3){ p=p+theme(axis.text.x=element_text(angle=45,vjust=1, hjust=1))}
FileName <- paste(name_i,"_kruskal.test_nosig_box", ".pdf", sep = "")
ggsave(FileName, p, width = 8, height = 8)
}
}}
}
### 结果文件展示
能读到这里，相信大家跃跃欲试了，全部分析文件上传github，供大家下载进行结果重现。
### 选择Tukey多重比较方法
Tukey多重计较方法，用来调用字母表示多重比较结果不同，下面是我整理好的代码：
```{r Tukey, echo=TRUE, message=FALSE, warning=FALSE, paged.print=FALSE}
library(multcomp)
model<-aov(dd ~ group, data=data_wt)#方差分析
# model<-aov(total.ASA.mg.g.1FW. ~ gruop, data=data_wt)#方差分析
summary(model)
litter.mc <- glht(model, linfct = mcp(group = 'Tukey'))
summary(litter.mc)
insx = cld(litter.mc)
TUK_a <- insx$mcletters$monospacedLetters
TUK_a = as.data.frame(TUK_a)
colnames(TUK_a) = c("value_aov")
head(TUK_a)写在后面
值得注意的是，我们在方差分析之后可以选择t检验两两比对差异，并使用P值矫正。同样非参数检验也使用类似的方法进行两两比对，但是就两组之间的显著性结果转化为字母标记，我并没有实现，大家如果有想法，多多赐教。
猜你喜欢
- 10000+: 菌群分析
宝宝与猫狗 提DNA发Nature 实验分析谁对结果影响大 Cell微生物专刊 肠道指挥大脑 - 系列教程：微生物组入门 Biostar 微生物组 宏基因组
- 专业技能：生信宝典 学术图表 高分文章 不可或缺的人
- 一文读懂：宏基因组 寄生虫益处 进化树
- 必备技能：提问 搜索 Endnote
- 文献阅读 热心肠 SemanticScholar Geenmedical
- 扩增子分析：图表解读 分析流程 统计绘图
- 16S功能预测 PICRUSt FAPROTAX Bugbase Tax4Fun
- 在线工具：16S预测培养基 生信绘图
- 科研经验：云笔记 云协作 公众号
- 编程模板: Shell R Perl
- 生物科普: 肠道细菌 人体上的生命 生命大跃进 细胞暗战 人体奥秘
写在后面
为鼓励读者交流、快速解决科研困难，我们建立了“宏基因组”专业讨论群，目前己有国内外5000+ 一线科研人员加入。参与讨论，获得专业解答，欢迎分享此文至朋友圈，并扫码加主编好友带你入群，务必备注“姓名-单位-研究方向-职称/年级”。技术问题寻求帮助，首先阅读《如何优雅的提问》学习解决问题思路，仍末解决群内讨论，问题不私聊，帮助同行。
学习扩增子、宏基因组科研思路和分析实战，关注“宏基因组”
点击阅读原文，跳转最新文章目录阅读
https://mp.weixin.qq.com/s/5jQspEvH5_4Xmart22gjMA
https://wap.sciencenet.cn/blog-3334560-1184225.html
上一篇：还在为投文章发愁吗，也许你更适合审别人的文章——JGG期刊专职编辑招聘（IF 4）
下一篇：ggThemeAssist：鼠标调整ggplot2主题，不用再记这些代码啦！
