前面由于對miRNA的探針數(shù)目沒有正確的理解，以為數(shù)據(jù)一直沒有下載完全，折騰了一番。后來經(jīng)老大jimmy提醒了，miRNA有2000左右的探針就是正常的呀。所以就可以愉快地繼續(xù)進(jìn)行分析啦！
下面是對數(shù)據(jù)集GSE85589中的原圖進(jìn)行復(fù)現(xiàn)，一篇WGCNA文章的原圖就到手了！
1.下載數(shù)據(jù)+準(zhǔn)備數(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='GSE85589_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('GSE85589', destdir=".",
AnnotGPL = F, ## 注釋文件
getGPL = F) ## 平臺文件
save(gset,file=f) ## 保存到本地
}
load('GSE85589_eSet.Rdata') ## 載入數(shù)據(jù)
class(gset) #查看數(shù)據(jù)類型
length(gset) #
class(gset[[1]])
# 因?yàn)檫@個GEO數(shù)據(jù)集只有一個GPL平臺，所以下載到的是一個含有一個元素的list
a=gset[[1]]
dat=exprs(a)
dim(dat)
pd=pData(a)
save(dat,pd,file = 'step1-rawdata')
#######探索match的過程
# load('step1-rawdata')
# probe2symbol <- data.table::fread(file = "GPL19117-74051.txt")#對于這樣的一個文件，就這么容易讀進(jìn)去了
#
# probe2symbol <- probe2symbol[grep("Homo sapiens", #挑選出智人的注釋信息
# ignore.case = F,
# probe2symbol$`Species Scientific Name`), ]
#
# dim(probe2symbol)
# table(probe2symbol$`Species Scientific Name`)#確保都是hs
# probe2symbol <- probe2symbol[ , c(1,4)]
# names(probe2symbol) <- c("PROBE_ID", "SYMBOL_ID")
#
# dat <- as.data.frame(dat)
# dat[1:4,1:4]
#
# rownames(dat) %in% probe2symbol$PROBE_ID
# table(rownames(dat) %in% probe2symbol$PROBE_ID)
# dat1 <- dat[match(rownames(dat),probe2symbol$PROBE_ID),]
# dat[1:4,1:4]
# dat2 <- dat[match(probe2symbol$PROBE_ID,rownames(dat)),]
# dat1[1:4,1:4]
# dat3 <- na.omit(dat2)
# dat2[1:4,1:4]
#
# ids <- probe2symbol[match(rownames(dat),probe2symbol$PROBE_ID),]
# rownames(dat) <- ids$SYMBOL_ID
# table(duplicated(rownames(dat)))#table后發(fā)現(xiàn)false為2578行，正好是dat的行數(shù)，說明沒有重復(fù)項(xiàng)
# #而其實(shí)table(duplicated(probe2symbol$SYMBOL_ID))后發(fā)現(xiàn)，還是有很多重復(fù)的基因名的，只是我們這里作為2578個的基因名是沒有重復(fù)的/
# table(duplicated(probe2symbol$SYMBOL_ID))
# dat[1:4,1:4]
##############################################################################
load('step1-rawdata')
dat <- as.data.frame(dat)
dat[1:4,1:4]
probe2symbol <- data.table::fread(file = "GPL19117-74051.txt")#對于這樣的一個文件，就這么容易讀進(jìn)去了
probe2symbol <- probe2symbol[grep("Homo sapiens", #挑選出智人的注釋信息
ignore.case = F,
probe2symbol$`Species Scientific Name`), ]
dim(probe2symbol)
table(probe2symbol$`Species Scientific Name`)#確保都是hs
probe2symbol <- probe2symbol[ , c(1,4)]
names(probe2symbol) <- c("PROBE_ID", "SYMBOL_ID")
ids <- probe2symbol
head(ids)
colnames(ids)=c('probe_id','symbol')
ids=ids[ids$symbol != '',]
ids=ids[ids$probe_id %in% rownames(dat),]
dat[1:4,1:4]
dat=dat[ids$probe_id,]
dat[1:4,1:4]
ids$median=apply(dat,1,median) #ids新建median這一列，列名為median，同時對dat這個矩陣按行操作，取每一行的中位數(shù)，將結(jié)果給到median這一列的每一行
ids=ids[order(ids$symbol,ids$median,decreasing = T),]#對ids$symbol按照ids$median中位數(shù)從大到小排列的順序排序，將對應(yīng)的行賦值為一個新的ids
ids=ids[!duplicated(ids$symbol),]#將symbol這一列取取出重復(fù)項(xiàng)，'!'為否，即取出不重復(fù)的項(xiàng)，去除重復(fù)的gene ，保留每個基因最大表達(dá)量結(jié)果s
dat=dat[ids$probe_id,] #新的ids取出probe_id這一列，將dat按照取出的這一列中的每一行組成一個新的dat
rownames(dat)=ids$symbol#把ids的symbol這一列中的每一行給dat作為dat的行名
dat[1:4,1:4] #保留每個基因ID第一次出現(xiàn)的信息
colnames(dat)
pdac <- grep('PC',pd$title)
normal <- grep('N[0-9]+\\b',pd$title)
x <- c(pdac,normal)
expr <- dat[,x]
#對pd_fil進(jìn)行去除冗余項(xiàng)
length(unique(pd[,1]))
length(unique(pd[,2]))
length(unique(pd[,3]))
apply(pd,2,function(x){length(unique(x))})
apply(pd,2,function(x){
length(unique(x))> 1
})
pd_fil <- pd[,apply(pd,2,function(x){
length(unique(x))> 1
})]
dim(pd_fil)
cli <- pd_fil[x,]
save(expr,cli,file = 'step1-input.Rdata')
2.做WGCNA分析
library(WGCNA)
rm(list = ls())
load('step1-input.Rdata')
#####step 1
datExpr0=as.data.frame(t(expr))
gsg = goodSamplesGenes(datExpr0, verbose = 3)
gsg$allOK
if(T){
sampleTree = hclust(dist(datExpr0), method = "average")
#sizeGrWindow(15,12)
par(cex = 0.6)
par(mar = c(0,4,2,0))
#png("dynamicColors_mergedColors.png",width = 800,height = 600)
pdf('Sample clustering.pdf',width = 25,height =20 )
plot(sampleTree, main = "Sample clustering to detect outliers", sub="", xlab="", cex.lab = 1.5, cex.axis = 1.5, cex.main = 2)
abline(h = 26.5, col = "red")
dev.off()
}
image-20191112220756510
#這個僅留做記錄，原文并沒有去掉離群樣本
clust = cutreeStatic(sampleTree, cutHeight = 26.5, minSize = 10)
table(clust) # 0代表切除的，1代表保留的
keepSamples = (clust==1)
datExpr = datExpr0[keepSamples, ]
下面是構(gòu)建無尺度網(wǎng)絡(luò)
###step 2
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ù)選擇范圍，計(jì)算無尺度分布拓?fù)渚仃? png("step2-beta-value.png",width = 800,height = 600)
# Plot the results:
##sizeGrWindow(9, 5)
par(mfrow = c(1,2));
cex1 = 0.9;
# 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.90,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")
image-20191121214914371
image-20191121214920739
如下原文所示，用的貝塔值是1，我的結(jié)果也是，然后R^2值是0.89，接下來選擇==一步法==
image-20191112225334998
###step 3
if(T){
cor <- WGCNA::cor
if(T){
net = blockwiseModules(
datExpr,
power = 1,
TOMType = "unsigned", minModuleSize = 30,
reassignThreshold = 0, mergeCutHeight = 0.25,
numericLabels = TRUE, pamRespectsDendro = FALSE,
saveTOMs = F,
verbose = 3
)
table(net$colors)
}
sizeGrWindow(12, 9)
mergedColors = labels2colors(net$colors)
pdf('step3-dynamicColors_mergedColors.pdf',width = 25,height =20 )
# Plot the dendrogram and the module colors underneath
plotDendroAndColors(net$dendrograms[[1]], mergedColors[net$blockGenes[[1]]],
"Module colors",
dendroLabels = FALSE, hang = 0.03,
addGuide = TRUE, guideHang = 0.05)
dev.off()
moduleLabels = net$colors
moduleColors = labels2colors(net$colors)
table(moduleColors)
MEs = net$MEs;
geneTree = net$dendrograms[[1]];
save(MEs, moduleLabels, moduleColors, geneTree,
file = "AS-green-FPKM-02-networkConstruction-auto.RData")
}
image-20191121214932208
###step 4
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)
pdf('step4-sample-subtype-cluster.pdf',width = 25,height =20 )
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()
}
image-20191113005038902
##step 5
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/006y8mN6gy1g9600thqfxj30no0xcq69.jpg" alt="image-20191121214946750" style="zoom:50%;" />
###step 6
###############首先計(jì)算模塊與基因的相關(guān)性矩陣
# 把各個module的名字提取出來（從第三個字符開始），用于一會重命名
modNames = substring(names(MEs), 3)
# 得到矩陣
geneModuleMembership = as.data.frame(cor(datExpr, MEs, use = "p"))
# 矩陣t檢驗(yàn)
MMPvalue = as.data.frame(corPvalueStudent(as.matrix(geneModuleMembership), nSamples))
# 修改列名
names(geneModuleMembership) = paste("MM", modNames, sep="")
names(MMPvalue) = paste("p.MM", modNames, sep="")
################再計(jì)算性狀與基因的相關(guān)性矩陣
PC <- as.data.frame(design[,2])
names(PC) = "PC"
# 得到矩陣
geneTraitSignificance = as.data.frame(cor(datExpr, PC, use = "p"))
# 矩陣t檢驗(yàn)
GSPvalue = as.data.frame(corPvalueStudent(as.matrix(geneTraitSignificance), nSamples))
# 修改列名
names(geneTraitSignificance) = paste("GS.", names(PC), sep="")
names(GSPvalue) = paste("p.GS.", names(PC), sep="")
###############最后把兩個相關(guān)性矩陣聯(lián)合起來,指定感興趣模塊進(jìn)行分析
###turquoise模塊
module = "turquoise"
column = match(module, modNames)#找到目標(biāo)模塊所在列
moduleGenes = moduleColors==module#找到模塊基因所在行
sizeGrWindow(7, 7)
par(mfrow = c(1,1))
verboseScatterplot(abs(geneModuleMembership[moduleGenes, column]),
abs(geneTraitSignificance[moduleGenes, 1]),
xlab = paste("Module Membership in", module, "module"),
ylab = "Gene significance for PC",
main = paste("Module membership vs. gene significance\n"),
cex.main = 1.2, cex.lab = 1.2, cex.axis = 1.2, col = module)
###brown模塊
module = "brown"
column = match(module, modNames)#找到目標(biāo)模塊所在列
moduleGenes = moduleColors==module#找到模塊基因所在行
sizeGrWindow(7, 7)
par(mfrow = c(1,1))
verboseScatterplot(abs(geneModuleMembership[moduleGenes, column]),
abs(geneTraitSignificance[moduleGenes, 1]),
xlab = paste("Module Membership in", module, "module"),
ylab = "Gene significance for PC",
main = paste("Module membership vs. gene significance\n"),
cex.main = 1.2, cex.lab = 1.2, cex.axis = 1.2, col = module)
image-20191121214958583
image-20191121215006188
###step 7
MEs = moduleEigengenes(datExpr, moduleColors)$eigengenes
## 只有連續(xù)型性狀才能只有計(jì)算
## 這里把是否屬于 Luminal 表型這個變量用0,1進(jìn)行數(shù)值化。
PC = as.data.frame(design[,2]);
names(PC) = "PC"
# Add the weight to existing module eigengenes
MET = orderMEs(cbind(MEs, PC))
# Plot the relationships among the eigengenes and the trait
sizeGrWindow(5,7.5);
par(cex = 0.9)
plotEigengeneNetworks(MET, "", marDendro = c(0,4,1,2), marHeatmap = c(3,4,1,2), cex.lab = 0.8, xLabelsAngle = 90)
# Plot the dendrogram
sizeGrWindow(6,6);
par(cex = 1.0)
## 模塊的聚類圖
plotEigengeneNetworks(MET, "Eigengene dendrogram", marDendro = c(0,4,2,0),
plotHeatmaps = FALSE)
# Plot the heatmap matrix (note: this plot will overwrite the dendrogram plot)
par(cex = 1.0)
## 性狀與模塊熱圖
plotEigengeneNetworks(MET, "Eigengene adjacency heatmap", marHeatmap = c(3,4,2,2),
plotDendrograms = FALSE, xLabelsAngle = 90)
image-20191121215014443
文章中的原圖
image-20191121215025849
image-20191113010507609
