前些天老大布置了WGCNA的作業(yè)：下載GSE106292 數(shù)據(jù)集的 Excel表格如何讀入R里面，做出作者文章中那樣的圖，但是分組很復(fù)雜，需要去文章中找細(xì)節(jié)內(nèi)容，老大jimmy還寫了篇推文：沒有生物學(xué)背景的數(shù)據(jù)分析很危險 ，反反復(fù)復(fù)重做了好幾次，終于做出和文章中的WGCNA的圖和富集分析的結(jié)果非常接近的答案，還挺開心的。
要復(fù)現(xiàn)的圖下
1.下載整理數(shù)據(jù)
rm(list = ls())
options(stringsAsFactors = F)
options(BioC_mirror="https://mirrors.ustc.edu.cn/bioc/")
options(CRAN="https://mirrors.tuna.tsinghua.edu.cn/CRAN/")
library(GEOquery)
library(WGCNA)
f='GSE106292_eSet.Rdata'
# https://www.ncbi.nlm.nih.gov/geo/query/acc.cgi?acc=GSE106292
# 這個包需要注意兩個配置，一般來說自動化的配置是足夠的。
#Setting options('download.file.method.GEOquery'='auto')
#Setting options('GEOquery.inmemory.gpl'=FALSE)
if(!file.exists(f)){
gset <- getGEO('GSE106292', destdir=".",
AnnotGPL = F, ## 注釋文件
getGPL = F) ## 平臺文件
save(gset,file=f) ## 保存到本地
}
load('GSE106292_eSet.Rdata') ## 載入數(shù)據(jù)
class(gset) #查看數(shù)據(jù)類型
length(gset) #
class(gset[[1]])
# 因為這個GEO數(shù)據(jù)集只有一個GPL平臺，所以下載到的是一個含有一個元素的list
a=gset[[1]]
dat=exprs(a)
dat<-read.csv('GSE106292_Human_Matrix_final.csv',sep = ',',row.names = 1)#rna-seq的數(shù)據(jù)以 Excel表格形式上傳了，因此上一步通過dat=exprs(a)并不能獲得表達(dá)矩陣信息，因此先下載表達(dá)矩陣再讀進(jìn)R里。
dim(dat)
dat<-dat[-1,]
rn_dat<-rownames(dat)
dat<-apply(dat,2,as.numeric)
dat=log2(dat+1)
dim(dat)
rownames(dat)<-rn_dat
dat[1:4,1:4]
colnames(dat)
colnames(dat)<-gsub('\\.',' ',colnames(dat))
colnames(dat)
pd=pData(a) #通過查看說明書知道取對象a里的臨床信息用pData
原文描述WGCNA的段落是：
Here we implemented RNA sequencing to generate cell type-specific transcriptomes for chondrocytes, osteoblasts, myoblasts, tenocytes and ligamentocytes at 17 weeks post-conception (WPC) of human development. We then employed Weighted Gene Co-expression Network Analysis (WGCNA) to define tissue-specific gene modules that represent each cell type.
pd=pd[pd$`developmental stage:ch1`=="17 wks",]
原文描述tissue和臨床信息表型對應(yīng)關(guān)系的文字如下
chondrocytes from the knee, myoblasts from the quadriceps, endosteal osteoblasts from the femur, and ligamentocytes and tenocytes from the anterior and posterior cruciate ligament and Achilles tendon, respectively.
chondrocytes<-pd[pd$`tissue:ch1`=='Knee',]
myoblasts<-pd[pd$`tissue:ch1`=='quadriceps muscle',]
osteoblasts<-pd[pd$`tissue:ch1`=='Femur',]
ligamentocytes<-pd[pd$`tissue:ch1`=='Anterior/Posterior Cruciate Ligament',]
tenocytes<-pd[pd$`tissue:ch1`=='Achilles Tendon',]
接下來提取出與分組信息相對應(yīng)的表達(dá)矩陣
pd1<-rbind(ligamentocytes,tenocytes,chondrocytes,myoblasts,osteoblasts)
pd2<-data.frame(row.names = rownames(pd1),
title=pd1$title,
tissue= rep(c('Ligamentocyte','Tenocyte','Chondrocyte','Myoblast','Osteoblast'),c(3,3,7,4,3)))
group_list<-rep(c('Ligamentocyte','Tenocyte','Chondrocyte','Myoblast','Osteoblast'),c(3,3,7,4,3))
dat1<-dat[,match(as.character(pd$title),colnames(dat))]
colnames(dat1)<-rownames(pd2)
dim(dat1)
dat1[1:4,1:4]
save(dat1,pd2,group_list,rn_dat,file = 'step1-input.Rdata')
load('step1-input.Rdata')
2.進(jìn)行數(shù)據(jù)檢查
rm(list = ls())
load('step1-input.Rdata')
dat<-dat1
dat<-apply(dat, 2, as.numeric)
table(apply(dat, 1, function(x) sum(x>1)))
table(apply(dat, 1, function(x) sum(x>1)==0))
table(apply(dat, 1, function(x) sum(x>1) > 5))
######################################## PCA ##########################################
if(T){
dat[1:4,1:4]
dat<-log2(dat+1)
## 下面是畫PCA的必須操作，需要看說明書。
dat=t(dat)#畫PCA圖時要求是行名時樣本名，列名時探針名，因此此時需要轉(zhuǎn)換
dat=as.data.frame(dat)#將matrix轉(zhuǎn)換為data.frame
dat=cbind(dat,group_list) #cbind橫向追加，即將分組信息追加到最后一列
#dat<-as.data.frame(dat)
library("FactoMineR")#畫主成分分析圖需要加載這兩個包
library("factoextra")
# The variable group_list (index = 54676) is removed
# before PCA analysis
dat.pca <- PCA(dat[,-ncol(dat)], graph = FALSE)#現(xiàn)在dat最后一列是group_list，需要重新賦值給一個dat.pca,這個矩陣是不含有分組信息的
fviz_pca_ind(dat.pca,
geom.ind = "point", # show points only (nbut not "text")
col.ind = dat$group_list, # color by groups
palette = c("#9370DB", "#FF82AB", "#87CEFF", "#2E8B57", "#0000FF"),
addEllipses = TRUE, # Concentration ellipses
legend.title = "Groups")
ggsave('PCA.png')
}
得到的下面的PCA圖可以看到各組間還是分的很開的。
<img src="https://tva1.sinaimg.cn/large/006y8mN6gy1g96038tnwpj30me0im77a.jpg" alt="image-20191121215206122" style="zoom:50%;" />
3.熱圖-復(fù)現(xiàn)圖a和圖b：Top5000熱圖+各組相關(guān)性熱圖
####################################### heatmap ##########################################
rm(list = ls())
options(stringsAsFactors = F)
load(file = 'step1-input.Rdata')
dat<-dat1
cg=names(tail(sort(apply(dat,1,function(x){sum(x)})),5000))#apply按行（'1'是按行取，'2'是按列取），對每一行進(jìn)行取表達(dá)量的最大值，從小到大排序，取最大的5000個
library(pheatmap)
pheatmap(dat[cg,],show_colnames =F,show_rownames = F) #對那些提取出來的1000個基因所在的每一行取出，組合起來為一個新的表達(dá)矩陣
n=t(scale(t(dat[cg,]))) # 'scale'可以對log-ratio數(shù)值進(jìn)行歸一化
n[n>3]=3
n[n< -3]= -3
n[1:4,1:4]
pheatmap(n,show_colnames =F,show_rownames = F)
ac=data.frame(g=group_list)
rownames(ac)=colnames(n) #把a(bǔ)c的行名給到n的列名，即對每一個探針標(biāo)記上分組信息（是'noTNBC'還是'TNBC'）
pheatmap(n,show_colnames =T,show_rownames = F,annotation_names_col = F,
annotation_col=ac,filename = 'heatmap_top5000.png')
共畫了3張熱圖，最后一張熱圖展示如下圖，與原文對比'Ligamentocyte'和'Chondrocyte'相比較其他組是高表達(dá)的。
ac=data.frame(tissue=pd2$tissue)
rownames(ac)=colnames(dat)
M=cor(log(dat+1)) #計算列與例之間的相關(guān)性系數(shù)
pheatmap::pheatmap(M,annotation_row = ac,
annotation_col = ac,filename = 'cor.png') #這個地方很神奇， annotation_col是對列進(jìn)行注釋，那么出圖結(jié)果是不僅加了列名，也加了行名
與原圖對比，可以看到Ligamentocyte與Chondrocyte的相關(guān)性還是比較高的，同時Ligamentocyte與Tenocyte組的相關(guān)性也是相比較其他組高。而Myoblast組與其他組的相關(guān)性是最低的，與原文章中的也是相似的。當(dāng)然，組內(nèi)的各樣本間相似性是最高的。
4.WGCNA-復(fù)現(xiàn)圖c：基因模塊與性狀相關(guān)性熱圖
參考：https://horvath.genetics.ucla.edu/html/CoexpressionNetwork/Rpackages/WGCNA/faq.html
文章中關(guān)于進(jìn)行WGCNA之前的數(shù)據(jù)為TPM數(shù)據(jù)(如下圖所示)，根據(jù)一文看懂WGCNA 分析(2019更新版)：如果是芯片數(shù)據(jù)，那么常規(guī)的歸一化矩陣即可，如果是轉(zhuǎn)錄組數(shù)據(jù)，最好是RPKM/TPM值或者其它歸一化好的表達(dá)量。肉眼查看表達(dá)矩陣的數(shù)值大小，有的成百上千，有的為個位數(shù)甚至0，那么就需要用log2來進(jìn)行歸一化處理。所以直接用前面處理好的'step1-input.Rdata'就可以了，因為里面的dat1是已經(jīng)經(jīng)過log處理了的。
接下來思考，我到底要不要過濾探針？
探針或基因可以通過平均表達(dá)或方差（或其魯棒性強(qiáng)的MAD（中位數(shù)和中位數(shù)絕對偏差）進(jìn)行過濾，因為低表達(dá)或不變好基因通常代表噪聲。是否最好按平均表達(dá)式或方差進(jìn)行篩選，這是一個爭論的問題。兩者都有優(yōu)點和缺點，但更重要的是，它們傾向于篩選出相似的基因集，因為平均值和方差通常是相關(guān)的。這篇文獻(xiàn)復(fù)現(xiàn)時并沒有采用通過基因表達(dá)量上的差異來過濾基因。經(jīng)過查閱資料搜多到相關(guān)解釋：WGCNA 被設(shè)計成一種無監(jiān)督的分析方法，根據(jù)基因的表達(dá)特征對基因進(jìn)行分組，通過基因表達(dá)量上的差異過濾后的基因，很可能就會導(dǎo)致形成一組相關(guān)基因就形成單個（或幾個高度相關(guān)的）模塊。我的理解是：如果通過基因表達(dá)量上的差異來過濾基因，就相當(dāng)于類似人為地去劃分模塊了，而我們要的利用未經(jīng)差異篩選后的表達(dá)矩陣來通過表達(dá)量高低與否將基因分在不同模塊。
接下來再思考，那么如果不進(jìn)行基因表達(dá)量上的差異來篩選基因，那么現(xiàn)在有20000多個基因，而且又有那么多表達(dá)量在很多樣本中都為零的基因，我該如何過濾呢？見下圖。
經(jīng)過搜索和嘗試，我決定并不過濾很多基因，最后
dat1<-dat1[!apply(dat1,1,function(x){sum(floor(x)==0)>15}),]來過濾基因，就是如果一個基因在20個樣本中如果有超過15個樣本表達(dá)量為0，那么這個基因我就不要了。過濾條件還是蠻低的，即使這么低，也還是過濾掉了20226-13178=7048個基因。
5.過濾基因，得到WGCNA的輸入數(shù)據(jù)
rm(list = ls())
load('step1-input.Rdata')
dat1<-as.data.frame(dat1)
dat1[1:4,1:4]
apply(dat1,1,function(x){sum(floor(x)==0)>15})
dat1<-dat1[!apply(dat1,1,function(x){sum(floor(x)==0)>15}),]
dim(dat1)
apply(dat1,2,function(x){range(x)})
dat1<-t(dat1)
sampleTree = hclust(dist(dat1), method = "average")
png("step1_sampleClustering.png",width = 800,height = 600)
plot(sampleTree, main = "Sample clustering to detect outliers", sub="", xlab="", cex.lab = 1.5,
cex.axis = 1.5, cex.main = 2)
dev.off()
#得到接下來要進(jìn)行WGCNA的輸入數(shù)據(jù)
datExpr<-dat1
datTraits = data.frame(group_list=group_list)
save(datExpr,datTraits,file = 'wgcna_input.Rdata')
load('wgcna_input.Rdata')
得到的樣本聚類樹可以看到，沒有明顯的離群樣本，因此不需要剔除離群樣本。
6.獲得Power值
rm(list = ls())
library(WGCNA)
load(file = 'wgcna_input.Rdata')
datExpr[1:4,1:4]
if(T){
powers = c(c(1:10), seq(from = 12, to=30, by=2))
# Call the network topology analysis function
sft = pickSoftThreshold(datExpr, powerVector = powers, verbose = 5)
#設(shè)置網(wǎng)絡(luò)構(gòu)建參數(shù)選擇范圍，計算無尺度分布拓?fù)渚仃? png("step2-beta-value.png",width = 800,height = 600)
# Plot the results:
##sizeGrWindow(9, 5)
par(mfrow = c(1,2));
cex1 = 0.7;
# Scale-free topology fit index as a function of the soft-thresholding power
plot(sft$fitIndices[,1], -sign(sft$fitIndices[,3])*sft$fitIndices[,2],
xlab="Soft Threshold (power)",ylab="Scale Free Topology Model Fit,signed R^2",type="n",
main = paste("Scale independence"));
text(sft$fitIndices[,1], -sign(sft$fitIndices[,3])*sft$fitIndices[,2],
labels=powers,cex=cex1,col="red");
# this line corresponds to using an R^2 cut-off of h
abline(h=0.7,col="red")
# Mean connectivity as a function of the soft-thresholding power
plot(sft$fitIndices[,1], sft$fitIndices[,5],
xlab="Soft Threshold (power)",ylab="Mean Connectivity", type="n",
main = paste("Mean connectivity"))
text(sft$fitIndices[,1], sft$fitIndices[,5], labels=powers, cex=cex1,col="red")
dev.off()
}
sft
sft$powerEstimate
save(sft,file = "step2_beta_value.Rdata")
查看軟閾值，發(fā)現(xiàn)$powerEstimate這個函數(shù)計算出的推薦的軟閾值是NA，但是通過搜索網(wǎng)上，發(fā)現(xiàn)這個問題同樣也被問過，軟閾值是可以自己挑選的，后面的步驟用自己挑選的就可以了。那么如何挑選？挑選SFT.R.sq的值盡量高，同時最大連通性mean.k.又不能太低。同時要根據(jù)下一步net$color生成的模塊數(shù)目，我這里選擇的power值是9,也就是R^2值為0.7。
7.構(gòu)建共表達(dá)矩陣
if(T){
net = blockwiseModules(
datExpr,
power = 9,
maxBlockSize = 6000,
TOMType = "unsigned", minModuleSize = 30,
reassignThreshold = 0, mergeCutHeight = 0.25,
numericLabels = TRUE, pamRespectsDendro = FALSE,
saveTOMs = F,
verbose = 3
)
table(net$colors)
}
通過設(shè)置power=9，同時minModuleSize = 30(每個模塊可包含的基因數(shù)目不能少于30個)，由于我看到有一些模塊如從11到19，所包含的基因數(shù)目太少了，都低于100，所以我想在后面的代碼中將minModuleSize設(shè)置為100。
確定了貝塔值之后，就可以將關(guān)系矩陣轉(zhuǎn)化為鄰近矩陣，接下來就可以轉(zhuǎn)換為tom重疊矩陣。為什么要轉(zhuǎn)換為tom矩陣？是因為在wgcna中，認(rèn)為模塊是tom重疊性基因高的基因，所以需要計算基因和基因之間的tom重疊性，從而判斷哪些基因應(yīng)該屬于同一個模塊，哪些基因不在同一個模塊。
8.模塊可視化
if(T){
#(1)網(wǎng)絡(luò)構(gòu)建
adjacency = adjacency(datExpr, power =9) #用softpower去計算鄰接矩陣
#(2) 鄰近矩陣到拓?fù)渚仃嚨霓D(zhuǎn)換，Turn adjacency into topological overlap
TOM = TOMsimilarity(adjacency);#鄰接矩陣轉(zhuǎn)換為tom重疊矩陣
dissTOM = 1-TOM
# (3) 聚類拓?fù)渚仃?Call the hierarchical clustering function
geneTree = hclust(as.dist(dissTOM), method = "average");#將計算結(jié)果賦值給聚類樹，計算方法是average，才是樹枝
# Plot the resulting clustering tree (dendrogram)
sizeGrWindow(12,9)
## 這個時候的geneTree與一步法的 net$dendrograms[[1]] 性質(zhì)類似，但是還需要進(jìn)行進(jìn)一步處理
plot(geneTree, xlab="", sub="", main = "Gene clustering on TOM-based dissimilarity",
labels = FALSE, hang = 0.04);
#(4) 聚類分支的修整 dynamicTreeCut
# We like large modules, so we set the minimum module size relatively high:
minModuleSize = 100;
# Module identification using dynamic tree cut:
dynamicMods = cutreeDynamic(dendro = geneTree, distM = dissTOM,
deepSplit = 2, pamRespectsDendro = FALSE,
minClusterSize = minModuleSize);
table(dynamicMods)
#繪畫結(jié)果展示
# Convert numeric lables into colors
dynamicColors = labels2colors(dynamicMods)
table(dynamicColors)
# Plot the dendrogram and colors underneath
#sizeGrWindow(8,6)
png("dynamic tree cut.png",width = 800,height = 600)
plotDendroAndColors(geneTree, dynamicColors, "Dynamic Tree Cut",
dendroLabels = FALSE, hang = 0.03,
addGuide = TRUE, guideHang = 0.05,
main = "Gene dendrogram and module colors")
dev.off()
}
##聚類結(jié)果相似模塊的融合，Merging of modules whose expression profiles are very similar
#在聚類樹中每一leaf是一個短線，代表一個基因，
#不同分之間靠的越近表示有高的共表達(dá)基因，將共表達(dá)極其相似的modules進(jìn)行融合
# Calculate eigengenes
if(T){
MEList = moduleEigengenes(datExpr, colors = dynamicColors)
MEs = MEList$eigengenes
# Calculate dissimilarity of module eigengenes
MEDiss = 1-cor(MEs);#計算模塊和模塊之間的相關(guān)性和相異性
# Cluster module eigengenes
METree = hclust(as.dist(MEDiss), method = "average");
# Plot the result
#sizeGrWindow(7, 6)
plot(METree, main = "Clustering of module eigengenes",
xlab = "", sub = "")
#建立基因模塊后，可以將模塊用顏色來區(qū)分，有些模塊相似性高，就需要將模塊合并。將模塊特征基因進(jìn)行聚類，在完成聚類后合并，0.15高度對應(yīng)的相似度閾值就是0.85。具體的相似性閾值可以自行設(shè)置，進(jìn)行聚類剪切后，就可以區(qū)分哪些模塊相似性高，哪些模塊相似性低，如下圖。
#選擇有95%相關(guān)性的進(jìn)行融合
MEDissThres = 0.15#0.15剪切高度可修改 ####可以完成相似模塊的合并，剪切高度是0.15，也就是將相似性高于0.85的模塊進(jìn)行了合并
# Plot the cut line into the dendrogram
abline(h=MEDissThres, col = "red")
# Call an automatic merging function
merge = mergeCloseModules(datExpr, dynamicColors, cutHeight = MEDissThres, verbose = 3)
# The merged module colors
mergedColors = merge$colors;
# Eigengenes of the new merged modules:
mergedMEs = merge$newMEs
png("dynamicColors_mergedColors.png",width = 800,height = 600)
plotDendroAndColors(geneTree, cbind(dynamicColors, mergedColors),
c("Dynamic Tree Cut", "Merged dynamic"),
dendroLabels = FALSE, hang = 0.03,
addGuide = TRUE, guideHang = 0.05)
dev.off()
}
觀察下圖中哪些模塊可以合并，設(shè)置融合線的高度。此處將融合高度設(shè)置為了0.15，完成相似模塊的合并。剪切高度根據(jù)實際情況可修改。當(dāng)剪切高度是0.15，也就是將相似性高于0.85的模塊進(jìn)行了合并。
經(jīng)過融合后的基因模塊與聚類樹一同顯示如下
9.樣本聚類可視化
if(T){
nGenes = ncol(datExpr)
nSamples = nrow(datExpr)
#首先針對樣本做個系統(tǒng)聚類
datExpr_tree<-hclust(dist(datExpr), method = "average")
#針對前面構(gòu)造的樣品矩陣添加對應(yīng)顏色
sample_colors1 <- numbers2colors(as.numeric(factor(datTraits$group_list)),
colors = c("green","blue","red","yellow","black"),signed = FALSE)
ssss=as.matrix(data.frame(group_list=sample_colors1))
par(mar = c(1,4,3,1),cex=0.8)
png("sample-subtype-cluster.png",width = 800,height = 600)
plotDendroAndColors(datExpr_tree, ssss,
groupLabels = colnames(sample),
cex.dendroLabels = 0.8,
marAll = c(1, 4, 3, 1),
cex.rowText = 0.01,
main = "Sample dendrogram and trait heatmap")
dev.off()
}
10.模塊和性狀的關(guān)系
## 這一步主要是針對于連續(xù)變量，如果是分類變量，需要轉(zhuǎn)換成連續(xù)變量方可使用
table(datTraits)
if(T){
nGenes = ncol(datExpr)
nSamples = nrow(datExpr)
design1=model.matrix(~0+as.factor(datTraits$group_list))
design=design1
colnames(design)
colnames(design)=c(levels(as.factor(datTraits$group_list)) )
moduleColors <- labels2colors(net$colors)
# Recalculate MEs with color labels
MEs0 = moduleEigengenes(datExpr, moduleColors)$eigengenes
MEs = orderMEs(MEs0); ##不同顏色的模塊的ME值矩 (樣本vs模塊)
moduleTraitCor = cor(MEs, design , use = "p");
moduleTraitPvalue = corPvalueStudent(moduleTraitCor, nSamples)
sizeGrWindow(10,6)
# Will display correlations and their p-values
textMatrix = paste(signif(moduleTraitCor, 2), "\n(",
signif(moduleTraitPvalue, 1), ")", sep = "");
dim(textMatrix) = dim(moduleTraitCor)
png("step5-Module-trait-relationships.png",width = 800,height = 1200,res = 120)
par(mar = c(6, 8.5, 3, 3));
# Display the correlation values within a heatmap plot
labeledHeatmap(Matrix = moduleTraitCor,
xLabels = colnames(design),
yLabels = names(MEs),
ySymbols = names(MEs),
colorLabels = FALSE,
colors = greenWhiteRed(50),
textMatrix = textMatrix,
setStdMargins = FALSE,
cex.text = 0.5,
zlim = c(-1,1),
main = paste("Module-trait relationships"))
dev.off()
table( labels2colors(net$colors))
}
<img src="https://tva1.sinaimg.cn/large/006y8mN6gy1g9605ywxb4j30nw0ygamj.jpg" alt="image-20191121215435698" style="zoom: 67%;" />
11.GO功能數(shù)據(jù)庫的注釋
table(moduleColors)
group_g=data.frame(gene=colnames(datExpr),
group=moduleColors)
save(group_g,file='wgcna_group_g.Rdata')
rm(list = ls())
load(file='wgcna_group_g.Rdata')
library(clusterProfiler)
# Convert gene ID into entrez genes
head(group_g)
tmp <- bitr(group_g$gene, fromType="SYMBOL",
toType="ENTREZID",
OrgDb="org.Hs.eg.db")
de_gene_clusters=merge(tmp,group_g,by.x='SYMBOL',by.y='gene')
table(de_gene_clusters$group)
head(de_gene_clusters)
list_de_gene_clusters <- split(de_gene_clusters$ENTREZID,
de_gene_clusters$group)
library(ggplot2)
gcSample= list_de_gene_clusters
source('function.R')
# 下一步非常耗時，保守估計半個小時
# 主要是對我們的模塊進(jìn)行功能注釋，就是GO/KEGG數(shù)據(jù)庫
com_kegg_go(gcSample,'top5000')
- 對于Myoblasts在GO數(shù)據(jù)庫中有富集通路如下
- 對于Osteoblasts在GO數(shù)據(jù)庫中有富集通路如下
- 對于Chondrocyte在GO數(shù)據(jù)庫中有富集通路如下
上面的數(shù)據(jù)在得到的csv表格中同樣能得到更多信息的驗證。
