一种在生态学领域玩转门特尔检验的技法

写在前面

对于生态学来讲,各种指标只有多,没有少,我们在这众多的指标中寻找对我们目标变量影响最大的指标。例如:

  • 环境指标对微生物群落的影响?

  • 生态学指标对生物固氮的影响?

  • 环境指标对温室气体排放的影响?

  • 人体血液等指标对肠道微生物稳态的影响?

  • 植物指标对植物抵御病害能力的影响?

这些指标之间往往有相互作用,排除其他指标,寻找目标指标对目标变量的影响。

例子

下图是一个例子,最外圈是各种环境因子,四个圈代表对这些环境因子分为四类,去除每组分类指标后分别对其他指标对目标指标做相关分析。我们今天也教给大家如何绘制这样一个图形。

实战

本次数据在此:(链接失效后台留言)

链接:https://pan.baidu.com/s/1HmkeO6cqvnU2yEkgx1oXlw

提取码:qon8

library(vegan)
library(tidyverse)
library(phyloseq)
library(readxl)

data <- read_xlsx("./env.xlsx",sheet = 1) %>% as.data.frame()
head(data)
dim(data)
data$ID = NULL
env.std <- data[-30]

#-分组#--------
group = read_xlsx("./env.xlsx",sheet = 2) %>% as.data.frame()
head(group)
colnames(group) = c("Group","ID")

num = unique(group$Group) %>% length()

BC.beta = vegan::vegdist((data["env30"]), method="bray")

不去除指标计算每个环境因子目标矩阵的相关

#--不做去除
report =c()
for(i in 1:ncol(env.std)){ ##
envdis = dist(env.std)
# pmantel.BC = mantel.partial(BC.beta, envdis, envdis2, na.rm=T)
pmantel.BC = vegan::mantel(envdis, BC.beta, na.rm=T)
# pmantel.JC = mantel.partial(JC.beta, envdis, envdis2, na.rm=T)
report = rbind(report,c(colnames(env.std)[i], pmantel.BC$statistic, pmantel.BC$signif))
}
colnames(report)<- c("Envs",paste(rep(c("r","p")),rep(c("BC","JC")),sep = "."))
report = as.matrix(report)
report = as.data.frame(report)
report[,2:dim(report)[2]]<-lapply(report[,2:dim(report)[2]],as.character)
report[,2:dim(report)[2]]<-lapply(report[,2:dim(report)[2]],as.numeric)
report1 <- report

去除土壤组变量的矩阵计算环境变量和目标变量相关

#---仅仅去除土壤
j = 4
rem <- group$ID[group$Group %in% unique(group$Group)[2:j]]
# JC.beta = vegan::vegdist(data["CUE"], method="jaccard",binary=T)
report =c()
for(i in 1:ncol(env.std)){
##
envdis = dist(env.std)
envdis2 = dist(env.std[,rem])
pmantel.BC = mantel.partial(BC.beta, envdis, envdis2, na.rm=T)
# pmantel.JC = mantel.partial(JC.beta, envdis, envdis2, na.rm=T)
report = rbind(report,c(colnames(env.std)[i], pmantel.BC$statistic, pmantel.BC$signif))
}

colnames(report)<- c("Envs",paste(rep(c("r","p")),rep(c("BC","JC")),sep = "."))
report = as.matrix(report)
report = as.data.frame(report)
report[,2:dim(report)[2]]<-lapply(report[,2:dim(report)[2]],as.character)
report[,2:dim(report)[2]]<-lapply(report[,2:dim(report)[2]],as.numeric)
report2 <- report
report2

去除土壤 + 植物组变量的矩阵计算环境变量和目标变量相关

#---去除土壤+ "plant"

rem <- group$ID[group$Group %in% unique(group$Group)[3:j]]
# JC.beta = vegan::vegdist(data["CUE"], method="jaccard",binary=T)
report =c()
for(i in 1:ncol(env.std)){ ##
envdis = dist(env.std)
envdis2 = dist(env.std[,rem])
pmantel.BC = mantel.partial(BC.beta, envdis, envdis2, na.rm=T)
# pmantel.JC = mantel.partial(JC.beta, envdis, envdis2, na.rm=T)
report = rbind(report,c(colnames(env.std)[i], pmantel.BC$statistic, pmantel.BC$signif))
}

colnames(report)<- c("Envs",paste(rep(c("r","p")),rep(c("BC","JC")),sep = "."))
report = as.matrix(report)
report = as.data.frame(report)
report[,2:dim(report)[2]]<-lapply(report[,2:dim(report)[2]],as.character)
report[,2:dim(report)[2]]<-lapply(report[,2:dim(report)[2]],as.numeric)
report3 <- report
report3

去除土壤 + 植物 + 酶活组变量的矩阵计算环境变量和目标变量相关

#---去除土壤+ "plant" + "enzyme

rem <- group$ID[group$Group %in% unique(group$Group)[4:j]]
# JC.beta = vegan::vegdist(data["CUE"], method="jaccard",binary=T)
report =c()
for(i in 1:ncol(env.std)){ ##
envdis = dist(env.std)
envdis2 = dist(env.std[,rem])
pmantel.BC = mantel.partial(BC.beta, envdis, envdis2, na.rm=T)
# pmantel.JC = mantel.partial(JC.beta, envdis, envdis2, na.rm=T)
report = rbind(report,c(colnames(env.std)[i], pmantel.BC$statistic, pmantel.BC$signif))
}

colnames(report)<- c("Envs",paste(rep(c("r","p")),rep(c("BC","JC")),sep = "."))
report = as.matrix(report)
report = as.data.frame(report)
report[,2:dim(report)[2]]<-lapply(report[,2:dim(report)[2]],as.character)
report[,2:dim(report)[2]]<-lapply(report[,2:dim(report)[2]],as.numeric)
report4 <- report
report4

去除该指标外全部指标后计算环境变量和目标变量相关

#---其他全部

report =c()
for(i in 1:ncol(env.std)){ ##
envdis = dist(env.std)
envdis2 = dist(env.std[,-i])
pmantel.BC = mantel.partial(BC.beta, envdis, envdis2, na.rm=T)
# pmantel.JC = mantel.partial(JC.beta, envdis, envdis2, na.rm=T)
report = rbind(report,c(colnames(env.std)[i], pmantel.BC$statistic, pmantel.BC$signif))
}

colnames(report)<- c("Envs",paste(rep(c("r","p")),rep(c("BC","JC")),sep = "."))
report = as.matrix(report)
report = as.data.frame(report)
report[,2:dim(report)[2]]<-lapply(report[,2:dim(report)[2]],as.character)
report[,2:dim(report)[2]]<-lapply(report[,2:dim(report)[2]],as.numeric)
report5 <- report
report5

整理数据准备出图

cor = rbind(report1$r.BC,report2$r.BC,report3$r.BC,report4$r.BC,report5$r.BC)

colnames(cor) = report1$Envs
row.names(cor) = c("zone","soil","plant","enzyme","all")

corp = rbind(report1$p.JC,report2$p.JC,report3$p.JC,report4$p.JC,report5$p.JC)

colnames(corp) = report1$Envs
row.names(corp) = c("zone","soil","plant","enzyme","all")

#-----------开始绘图#--------------
occor.r = cor
occor.p = corp
# occor.r[occor.p > p.threshold|abs(occor.r) < r.threshold] = 0

head(occor.r)
occor.r = as.data.frame(occor.r)

data <- cor %>% as.data.frame()
data$id = row.names(data)
pcm = reshape2::melt(data, id = c("id"))
pcm1 = pcm

head(group)
group2 = group %>% filter(Group != "mubiao")
head(group2)
colname = colnames(data)
rowname = row.names(data)

df0 = NULL
for (i in 1:4) {

b = group2$ID[group2$Group == unique(group2$Group)[i]]
pcmsub <- pcm %>% filter(variable %in% b)
pcmsub1 = pcmsub

if (i == 1) {
pcmsub$id = factor(pcmsub$id,levels = unique(pcmsub$id)) %>% as.numeric()
pcmsub$variable = factor(as.character(pcmsub$variable),levels = unique(pcmsub$variable)) %>% as.numeric()
# df = pcmsub
colnames(pcmsub) = c("x","y","r")
df0 = pcmsub
#---y轴标签#----
laby.data0 = data.frame(x = length(rowname),y = 1:max(df0$y),
laby = unique(pcmsub1$variable))
} else {
pcmsub$id = factor(pcmsub$id,levels = unique(pcmsub$id)) %>% as.numeric()

pcmsub$variable = factor((pcmsub$variable),levels = unique(pcmsub$variable)) %>% as.numeric()
pcmsub$variable = pcmsub$variable + 1 + max(df0$y)
colnames(pcmsub) = c("x","y","r")
df0 = rbind(df0,pcmsub)
laby.data1 = data.frame(x = length(rowname),y = min(pcmsub$y):max(pcmsub$y),laby = unique(pcmsub1$variable))
laby.data0 = rbind(laby.data0,laby.data1)
}
}

df = df0
laby.data = laby.data0

head(df)

p = ggplot() +
geom_tile(aes(x = x, y = y,fill=r),data = df,color='gray',size=0.5)+
# geom_point(aes(x = x, y = y,fill=r),df, shape=22,color='white')+
scale_size(range = c(1, 8))+
scale_fill_distiller(palette="RdYlBu") +
geom_text(aes(x = x,y = y,label = round(r,2)),data = df)
p
p = ggplot() +
geom_tile(aes(x = x, y = y,fill=r),data = df,color='gray',size=0.5)+
# geom_point(aes(x = x, y = y,fill=r),df, shape=22,color='white')+
scale_size(range = c(1, 8))+
scale_fill_distiller(palette="RdYlBu") +
geom_text(aes(x = x,y = y,label = round(r,2)),data = df)
p

ggsave("cs.pdf",p,width = 8,height = 12)

p + geom_tile(aes(x = max(df$x) + 1, y = df$y ),color='black',fill = 'white',size=0.5)

p +coord_fixed(ratio = 1)

#------设置标签
data$id = NULL
n =dim(data)
# colname = colnames(data)
rowname = row.names(data)

#--x轴标签#----
labx.data = data.frame(x = 1:n[1],y = 0,labx = rowname)
p + geom_text(aes(x = x + 1 ,y = y,label = laby),data = laby.data,hjust = 0)
p = p + geom_text(aes(x = x +1,y = y,label = laby),data = laby.data,hjust = 0) +
geom_text(aes(x = x,y = y + 11,label = labx),data = labx.data) +
geom_text(aes(x = x ,y = y + 5,label = labx),data = labx.data) +
theme_void()
p

p + coord_polar(theta = "y",start = pi / 3) +
xlim(c(-15,25)) + theme_void()

### 设定角度

head(df)
ID = paste(1:max(laby.data$y))
angle1 = 90 - 360 * ( as.numeric(ID) - 0.5) /length(ID)
angle1 = angle1[laby.data$y]
library(ggtree)

df$angle = sort(rep(angle1 -90,5), decreasing =T )

p <- ggplot() +
geom_tile(aes(x = x, y = y,fill=r),data = df,color='white',size=1.5)+
# geom_point(aes(x = x, y = y,fill=r),df, shape=22,color='white')+
scale_size(range = c(1, 8))+
scale_fill_distiller(palette="RdYlBu") +
# geom_text(aes(x = x,y = y,label = round(r,2)),data = df , angle = df$angle) +
coord_polar(theta = "y",start = 0) +
xlim(c(-10,8)) + theme_void() +
geom_text(aes(x = x,y = y,label = labx),data = labx.data,hjust = 0) +
# geom_text(aes(x = x,y = y + 11,label = labx),data = labx.data,angle = -10) +
# geom_text(aes(x = x ,y = y + 5,label = labx),data = labx.data,angle = 90,hjust = 0) +
geom_text(aes(x = x + 3,y = y,label = laby),data = laby.data,hjust = 0.5, angle = angle1+ 90)
p

occor.r[occor.p > p.threshold] = 0

head(occor.r)
occor.r = as.data.frame(occor.r)
data <- occor.r

data$id = row.names(data)
pcm = reshape2::melt(data, id = c("id"))
pcm1 = pcm

colname = colnames(data)
rowname = row.names(data)

df0 = NULL
for (i in 1:4) {

b = group2$ID[group2$Group == unique(group2$Group)[i]]
pcmsub <- pcm %>% filter(variable %in% b)
pcmsub1 = pcmsub

if (i == 1) {
pcmsub$id = factor(pcmsub$id,levels = unique(pcmsub$id)) %>% as.numeric()
pcmsub$variable = factor(as.character(pcmsub$variable),levels = unique(pcmsub$variable)) %>% as.numeric()
# df = pcmsub
colnames(pcmsub) = c("x","y","r")
df0 = pcmsub
#---y轴标签#----
laby.data0 = data.frame(x = length(rowname),y = 1:max(df0$y),
laby = unique(pcmsub1$variable))
} else {
pcmsub$id = factor(pcmsub$id,levels = unique(pcmsub$id)) %>% as.numeric()

pcmsub$variable = factor((pcmsub$variable),levels = unique(pcmsub$variable)) %>% as.numeric()
pcmsub$variable = pcmsub$variable + 1 + max(df0$y)
colnames(pcmsub) = c("x","y","r")
df0 = rbind(df0,pcmsub)
laby.data1 = data.frame(x = length(rowname),y = min(pcmsub$y):max(pcmsub$y),laby = unique(pcmsub1$variable))
laby.data0 = rbind(laby.data0,laby.data1)
}
}
df0
df1 = df0

df2 <- df1 %>% filter(r != 0)
p = p + geom_tile(aes(x = x, y = y,fill=r),data = df2,color='black',size=0.5)

p <- p +
geom_text(aes(x = x,y = y,label = round(r,2)),data = df , angle = df$angle) +
geom_tile(aes(x = max(df$x)+ 2, y = df$y ),color='black',fill = 'white',size=0.5)

p
ggsave("cs5.pdf",p,width = 12,height = 12)

根际互作生物学研究室 简介

根际互作生物学研究室是沈其荣教授土壤微生物与有机肥团队下的一个关注于根际互作的研究小组。本小组由袁军副教授带领,主要关注:1.植物和微生物互作在抗病过程中的作用;2 环境微生物大数据整合研究;3 环境代谢组及其与微生物过程研究体系开发和应用。团队在过去三年中在 isme J, Microbiome, PCE,SBB,Horticulture Research等期刊上发表了多篇文章。欢迎关注 微生信生物 公众号对本研究小组进行了解。

团队工作及其成果 (点击查看)

(0)

相关推荐

  • 三阴性乳腺癌表达矩阵探索笔记之差异性分析

    以第一个基因为例,根据group_list来检验在分组之间是否存在差异 load(file='step1-output.RData') dat[1:4,1:4] table(group_list) # ...

  • 【数据竞赛】Kaggle实战之单类别变量特征工程总结!

    作者:尘沙杰少.樱落.新峰.DOTA.谢嘉嘉 前言 在之前的文章中,我们已经介绍过部分类别特征编码的内容,此处,我们将所有的内容进行整合为一个系列,我们不罗列过多的知识点,重点介绍在kaggle过往几 ...

  • HNSCC数据分析-GSE2379-GPL830-GPL91

    五月份的学徒专注于GEO数据库里面的表达量芯片数据处理,主要的难点是表达量矩阵获取和探针的基因名字转换,合理的分组后就是标准的差异分析,富集分析.主要是参考我八年前的笔记: 解读GEO数据存放规律及下 ...

  • 怎么样才能正确的学习生信分析呢?—从学徒做起

    昨天的我可以为你做些什么好像阅读量不高,不过效果还是蛮显著的,跟部分粉丝聊了聊,希望对他们有帮助吧! 我们的生信故事会一直在征稿,详见:生信故事会栏目征稿启事 下面分享一下最新投稿,讲述跨专业转行学习 ...

  • 生物学背景知识之细胞周期推断

     前 · 言  第二单元第九讲:生物学背景知识之细胞周期推断 上一次说到通过PAM50基因进行乳腺癌分型,利用的就是自己的表达矩阵和PAM50基因比较,看表达量变化进行分类.细胞周期分类和PAM50类 ...

  • R绘图笔记 | 热图绘制

    关于绘图,前面介绍了一些: R绘图笔记 | 一般的散点图绘制 R绘图笔记 | 柱状图绘制 R绘图笔记 | 直方图和核密度估计图的绘制 R绘图笔记 | 二维散点图与统计直方图组合 R绘图笔记 | 散点分 ...

  • ccRCC数据分析-GSE66270-GPL570

    数据集介绍 GEO链接:https://www.ncbi.nlm.nih.gov/geo/query/acc.cgi?acc=GSE66270 芯片平台:GPL570,  [HG-U133_Plus_ ...

  • 比较不同流程(limma/voom,edgeR,DESeq2 )差异分析的区别

    前言: 距离第一次听说生信已经十几年了,现在是邋遢大叔重新开始学代码,精力确实已不像从前,各位入坑还是要乘早.后来约莫在5年前,课题组当时有个RNA-Seq数据,lab meeting时听瑞典小哥在汇 ...

  • 什么,你需要1T内存!!!

    最近接了一个61个10x的单细胞转录组样品项目,使用以前的流程,自动进行质量控制,降维聚类分群,本来应该是分分钟的事情,但是在一个步骤居然卡死了,我看了的这个函数,doubletFinder_v3 , ...

  • 《GEO数据挖掘课程》配套练习题粗浅的答案

    前面我布置了一系列学徒作业,其中有一个虽然是单一作业,但是工作量相当于一个本科毕业设计:<GEO数据挖掘课程>配套练习题,关于这个课程学徒也写了一系列笔记:学徒写的<GEO数据挖掘课 ...

  • R语言-multiROC package

    欢迎来到医科研,这里是白介素2的读书笔记,跟我一起聊临床与科研的故事, 生物医学数据挖掘,R语言,TCGA.GEO数据挖掘. 找ROC相关的包 Sys.setlocale('LC_ALL','C') ...

  • 如果你觉得相关性热图不好看,或者太简陋

    前面的教程:混合到同一个10X样品里面的多个细胞系如何注释,我们提到了可以使用细胞系的表达量矩阵去跟细胞亚群表达量矩阵进行相关性计算. 就有粉丝提问,把单细胞亚群使用   AverageExpress ...

  • Seurat包的findmarkers函数只能根据划分好的亚群进行差异分析吗

    结业考核20题:https://mp.weixin.qq.com/s/lpoHhZqi-_ASUaIfpnX96w 课程配套资料文档在:https://docs.qq.com/doc/DT2NwV0F ...

  • 批量获取指定多个学者已发表的科研文章

    新媒体管家 最近,我有一个小任务,需要把清单上提及的老师们公开发表过的文章做个记录. 我大致数了一下,大概有几十来号人,像这种工作,绝不可能让我一个一个上WOS或者Pubmed检索吧,多费劲. 考虑到 ...

  • TCGA(转录组)差异分析三大R包及其结果对比

    最近我们最优秀的R语言讲师小洁也开启了TCGA知识库打卡之旅,分享一下她其中一个学习成果,TCGA(转录组)差异分析三大R包及其结果对比. 如果你跟着她的教程学会了相关分析,可以尝试完成一个学徒作业: ...

  • ccRCC数据分析-GSE14672-GPL4866

    五月份的学徒专注于GEO数据库里面的表达量芯片数据处理,主要的难点是表达量矩阵获取和探针的基因名字转换,合理的分组后就是标准的差异分析,富集分析.主要是参考我八年前的笔记: 解读GEO数据存放规律及下 ...