差分网络分析DiffCoEx

简介

WGCNA网络分析以后,我们可以对一些sample构建出共表达的网络,那么这里有一个问题,那就是不同处理下的sample(比方说treat和control),它们的共表达网络是一样的吗?如果不一样,那些产生差异的gene pair是否与这些处理有关系,是否是一种比较重要的核心基因呢?

本篇推文老药新用,这是一篇2010年发表的文章:《DiffCoEx: a simple and sensitive method to find differentially coexpressed gene modules》
这篇文章基于传统的WGCNA构建的网络,来寻找两种处理的差异共表达网络

数学原理

构建差分网络大致分为5个步骤:
step 1:
建立邻接矩阵C,邻接矩阵是由两个gene pair的相关性来表征的,即两个基因之间的权重

step 2:
计算gene pair在两个组别权重的变化程度,并构建邻接变化矩阵 D;处理组为 [1],对照组为 [2]

其中:

  1. C[1]ij 代表处理组的邻接矩阵;C[2]ij 代表对照组的邻接矩阵
  2. β 为WGCNA的计算邻接矩阵的指数 β
  3. sign() 为符号函数

如果 dij 越高,代表在 A 处理中 gene i 和 gene j 权重(相关性,调控关系)与 在 B 处理中 gene i 和 gene j 权重(相关性,调控关系)的差值越大,即 gene i 与 gene j 的权重(相关性,调控关系)在两个处理组之间具有显著差异

step 3:
由邻接变化矩阵 D 计算相异矩阵 T


其中,k 代表与 gene i 和 gene j 不同的 gene k
那么相异矩阵 T 考虑了第三方gene k所带来的影响,那么tij 越低,代表在 A 处理中 gene i 和 gene j 权重(相关性,调控关系)与 在 B 处理中 gene i 和 gene j 权重(相关性,调控关系)的差值越大,即 gene i 与 gene j 的权重(相关性,调控关系)在两个处理组之间具有显著差异

理解:假设C[1]ij很高,C[2]ij很低,则 dij 很高,代表在 A 处理中 gene i 和 gene j 权重(相关性,调控关系)与 在 B 处理中 gene i 和 gene j 权重(相关性,调控关系)的差值越大,即 gene i 与 gene j 的权重(相关性,调控关系)在两个处理组之间具有显著差异,此时,tij 值就越低

step 4:
进行树聚类,由step3中可知,tij 值小代表在 A 处理中 gene i 和 gene j 权重(相关性,调控关系)与 在 B 处理中 gene i 和 gene j 权重(相关性,调控关系)有显著差异;即代表在 A 处理中 gene i 和 gene j 权重(相关性,调控关系)与 在 B 处理中 gene i 和 gene j 权重(相关性,调控关系)的差值越大,

step 5:
显著性统计

代码:

作者以一套RNA探针表达谱的数据为例子:
数据在这里下载:http://www.ncbi.nlm.nih.gov/sites/GDSbrowser?acc=GDS2901

#required libraries
#WGCNA package can be found at
#http://www.genetics.ucla.edu/labs/horvath/CoexpressionNetwork/Rpackages/WGCNA
library(WGCNA)          ###used for topological overlap calculation and clustering steps
library(RColorBrewer)   ###used to create nicer colour palettes
library(preprocessCore) ###used by the quantile normalization function
library(flashClust)

#Note: the data can be downloaded from the Gene Expression Omnibus
# http://www.ncbi.nlm.nih.gov/sites/GDSbrowser?acc=GDS2901
data<-as.matrix(read.csv(file="GDS2901.soft",skip=166,row.names=1,sep="\t",header=T))
data<-data[-15924,]
rawData<-matrix(as.numeric(data[,-1]),nrow=15923)
dimnames(rawData)<-dimnames(data[,-1])
#we create an annotation matrix containing the matches between probesets and gene names
anno<-as.matrix(data[-2475,1]) 
normData<-normalize.quantiles(log2(rawData))
dimnames(normData)<-dimnames(rawData)

#we remove the probeset at index 2475 because
#after quantile normalization it has zero variance
#(the probeset has the highest signal of all samples)
normData<-normData[-2475,]  
# 定义组别 1 的邻接矩阵
datC1<-t(normData[,c(1:12,25:36,37:48)]) ### these samples correspond to the Eker mutants.
# Note that since the Eker mutants have two sets of 12 control samples (13:24 and 37:48)
# we discard one to have a symmetric perturbation (carcinogenic vs control) between the two conditions (Eker mutants vs wild-types)
# 定义组别 2 的邻接矩阵
datC2<-t(normData[,49:84]) ###those samples correspond to the wild-types

# 定义 β 值
beta1=6 #user defined parameter for soft thresholding
# 可参考step 2数学原理
AdjMatC1<-sign(cor(datC1,method="spearman"))*(cor(datC1,method="spearman"))^2
AdjMatC2<-sign(cor(datC2,method="spearman"))*(cor(datC2,method="spearman"))^2
diag(AdjMatC1)<-0
diag(AdjMatC2)<-0
collectGarbage()
# 计算相异矩阵 T
dissTOMC1C2=TOMdist((abs(AdjMatC1-AdjMatC2)/2)^(beta1/2))
collectGarbage()

# 对相异矩阵 T 进行聚类
#Hierarchical clustering is performed using the Topological Overlap of the adjacency difference as input distance matrix
geneTreeC1C2 = flashClust(as.dist(dissTOMC1C2), method = "average");

# Plot the resulting clustering tree (dendrogram)
png(file="hierarchicalTree.png",height=1000,width=1000)
plot(geneTreeC1C2, xlab="", sub="", main = "Gene clustering on TOM-based dissimilarity",labels = FALSE, hang = 0.04);
dev.off()

#We now extract modules from the hierarchical tree. This is done using cutreeDynamic. Please refer to WGCNA package documentation for details
dynamicModsHybridC1C2 = cutreeDynamic(dendro = geneTreeC1C2, distM = dissTOMC1C2,method="hybrid",cutHeight=.996,deepSplit = T, pamRespectsDendro = FALSE,minClusterSize = 20);

#Every module is assigned a color. Note that GREY is reserved for genes which do not belong to any differentially coexpressed module
dynamicColorsHybridC1C2 = labels2colors(dynamicModsHybridC1C2)

#the next step merges clusters which are close (see WGCNA package documentation)
mergedColorC1C2<-mergeCloseModules(rbind(datC1,datC2),dynamicColorsHybridC1C2,cutHeight=.2)$color
colorh1C1C2<-mergedColorC1C2

#reassign better colors
colorh1C1C2[which(colorh1C1C2 =="midnightblue")]<-"red"
colorh1C1C2[which(colorh1C1C2 =="lightgreen")]<-"yellow"

colorh1C1C2[which(colorh1C1C2 =="cyan")]<-"orange"
colorh1C1C2[which(colorh1C1C2 =="lightcyan")]<-"green"
# Plot the dendrogram and colors underneath
png(file="module_assignment.png",width=1000,height=1000)
plotDendroAndColors(geneTreeC1C2, colorh1C1C2, "Hybrid Tree Cut",dendroLabels = FALSE, hang = 0.03,addGuide = TRUE, guideHang = 0.05,main = "Gene dendrogram and module colors cells")
dev.off()

#We write each module to an individual file containing affymetrix probeset IDs
modulesC1C2Merged<-extractModules(colorh1C1C2,datC1,anno,dir="modules",file_prefix=paste("Output","Specific_module",sep=''),write=T)
write.table(colorh1C1C2,file="module_assignment.txt",row.names=F,col.names=F,quote=F)

#We plot to a file the comparative heatmap showing correlation changes in the modules
#The code for the function plotC1C2Heatmap and others can be found below under the Supporting Functions section

plotC1C2Heatmap(colorh1C1C2,AdjMatC1,AdjMatC2, datC1, datC2)
png(file="exprChange.png",height=500,width=500)
plotExprChange(datC1,datC2,colorh1C1C2)
dev.off()

进行显著性分析

#This function computes the dispersion value that
#quantifies the change in correlation between two conditions
#for pair of genes drawn from module c1 and module c2
# in case c1 = c2, the function quantifies the differential coexpression in c1.
#cf Choi and Kendziorski 2009
dispersionModule2Module<-function(c1,c2,datC1,datC2,colorh1C1C2)
{
    if (c1==c2)
    {
       difCor<-(cor(datC1[,which(colorh1C1C2 == c1)],method="spearman")-
       cor(datC2[,which(colorh1C1C2 == c1)],method="spearman"))^2
       n<-length(which(colorh1C1C2  ==c1))
      (1/((n^2 -n)/2)*(sum(difCor)/2))^(.5)
    }
    else if (c1!=c2)
    {
      difCor<-(cor(datC1[,which(colorh1C1C2 == c1)],datC1[,which(colorh1C1C2==c2)],method="spearman")-
              cor(datC2[,which(colorh1C1C2 == c1)],datC2[,which(colorh1C1C2==c2)],method="spearman"))^2
      n1<-length(which(colorh1C1C2  ==c1))
      n2<-length(which(colorh1C1C2  ==c2))
      (1/((n1*n2))*(sum(difCor)))^(.5)
    }
}

# we generate a set of 1000 permuted indexes
permutations<-NULL
for (i in 1:1000)
{
   permutations<-rbind(permutations,sample(1:(nrow(datC1)+nrow(datC2)),nrow(datC1)))
}

# we scale the data in both conditions to mean 0 and variance 1.
d<-rbind(scale(datC1),scale(datC2))

# This function calculates the dispersion value of a module to module coexpression change on permuted data
permutationProcedureModule2Module<-function(permutation,d,c1,c2,colorh1C1C2)
{
  d1<-d[permutation,]
  d2<-d[-permutation,]
  dispersionModule2Module(c1,c2,d1,d2,colorh1C1C2)
}

#We compute all pairwise module to module dispersion values, and generate a null distribution from permuted scaled data
dispersionMatrix<-matrix(nrow=length(unique(colorh1C1C2))-1,ncol=length(unique(colorh1C1C2))-1)
nullDistrib<-list()
i<-j<-0
for (c1 in setdiff(unique(colorh1C1C2),"grey"))
{
  i<-i+1
  j<-0
  nullDistrib[[c1]]<-list()
  for (c2 in setdiff(unique(colorh1C1C2),"grey"))
  {
    j<-j+1
    dispersionMatrix[i,j]<-dispersionModule2Module(c1,c2,datC1,datC2,colorh1C1C2)
    nullDistrib[[c1]][[c2]]<-apply(permutations,1,permutationProcedureModule2Module,d,c2,c1,colorh1C1C2)
  }
}


#We create a summary matrix indicating for each module to module 
#differential coexpression the number of permuted data yielding 
#an equal or higher dispersion.
permutationSummary<-matrix(nrow=8,ncol=8)
colnames(permutationSummary)<-setdiff(unique(colorh1C1C2),"grey")
rownames(permutationSummary)<-setdiff(unique(colorh1C1C2),"grey")
for (i in 1:8) { 
  for (j in 1:8) {
     permutationSummary[i,j]<-length(which(nullDistrib[[i]][[j]] >= dispersionMatrix[i,j]))
                  }
}

#We plot the result (cf supplementary figure 1)
plotMatrix(permutationSummary)

关于相异矩阵 dissTOMC1C2 的理解:


gene_1 与 gene_2 的系数为 0.9731268,代表在 A 处理中 gene 1 和 gene 2 权重(相关性,调控关系)与 在 B 处理中 gene i 和 gene j 权重(相关性,调控关系)的相异系数 tij 为 0.9731268(相异系数 tij 越大代表:在 A 处理中 gene i 和 gene j 权重(相关性,调控关系)与 在 B 处理中 gene i 和 gene j 权重(相关性,调控关系)差异越小;反之越大)

最后编辑于
©著作权归作者所有,转载或内容合作请联系作者
  • 序言:七十年代末,一起剥皮案震惊了整个滨河市,随后出现的几起案子,更是在滨河造成了极大的恐慌,老刑警刘岩,带你破解...
    沈念sama阅读 199,711评论 5 468
  • 序言:滨河连续发生了三起死亡事件,死亡现场离奇诡异,居然都是意外死亡,警方通过查阅死者的电脑和手机,发现死者居然都...
    沈念sama阅读 83,932评论 2 376
  • 文/潘晓璐 我一进店门,熙熙楼的掌柜王于贵愁眉苦脸地迎上来,“玉大人,你说我怎么就摊上这事。” “怎么了?”我有些...
    开封第一讲书人阅读 146,770评论 0 330
  • 文/不坏的土叔 我叫张陵,是天一观的道长。 经常有香客问我,道长,这世上最难降的妖魔是什么? 我笑而不...
    开封第一讲书人阅读 53,799评论 1 271
  • 正文 为了忘掉前任,我火速办了婚礼,结果婚礼上,老公的妹妹穿的比我还像新娘。我一直安慰自己,他们只是感情好,可当我...
    茶点故事阅读 62,697评论 5 359
  • 文/花漫 我一把揭开白布。 她就那样静静地躺着,像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上,一...
    开封第一讲书人阅读 48,069评论 1 276
  • 那天,我揣着相机与录音,去河边找鬼。 笑死,一个胖子当着我的面吹牛,可吹牛的内容都是我干的。 我是一名探鬼主播,决...
    沈念sama阅读 37,535评论 3 390
  • 文/苍兰香墨 我猛地睁开眼,长吁一口气:“原来是场噩梦啊……” “哼!你这毒妇竟也来了?” 一声冷哼从身侧响起,我...
    开封第一讲书人阅读 36,200评论 0 254
  • 序言:老挝万荣一对情侣失踪,失踪者是张志新(化名)和其女友刘颖,没想到半个月后,有当地人在树林里发现了一具尸体,经...
    沈念sama阅读 40,353评论 1 294
  • 正文 独居荒郊野岭守林人离奇死亡,尸身上长有42处带血的脓包…… 初始之章·张勋 以下内容为张勋视角 年9月15日...
    茶点故事阅读 35,290评论 2 317
  • 正文 我和宋清朗相恋三年,在试婚纱的时候发现自己被绿了。 大学时的朋友给我发了我未婚夫和他白月光在一起吃饭的照片。...
    茶点故事阅读 37,331评论 1 329
  • 序言:一个原本活蹦乱跳的男人离奇死亡,死状恐怖,灵堂内的尸体忽然破棺而出,到底是诈尸还是另有隐情,我是刑警宁泽,带...
    沈念sama阅读 33,020评论 3 315
  • 正文 年R本政府宣布,位于F岛的核电站,受9级特大地震影响,放射性物质发生泄漏。R本人自食恶果不足惜,却给世界环境...
    茶点故事阅读 38,610评论 3 303
  • 文/蒙蒙 一、第九天 我趴在偏房一处隐蔽的房顶上张望。 院中可真热闹,春花似锦、人声如沸。这庄子的主人今日做“春日...
    开封第一讲书人阅读 29,694评论 0 19
  • 文/苍兰香墨 我抬头看了看天上的太阳。三九已至,却和暖如春,着一层夹袄步出监牢的瞬间,已是汗流浃背。 一阵脚步声响...
    开封第一讲书人阅读 30,927评论 1 255
  • 我被黑心中介骗来泰国打工, 没想到刚下飞机就差点儿被人妖公主榨干…… 1. 我叫王不留,地道东北人。 一个月前我还...
    沈念sama阅读 42,330评论 2 346
  • 正文 我出身青楼,却偏偏与公主长得像,于是被迫代替她去往敌国和亲。 传闻我的和亲对象是个残疾皇子,可洞房花烛夜当晚...
    茶点故事阅读 41,904评论 2 341

推荐阅读更多精彩内容