下面是cibersort的原始代码,一共200多行,要想了解这个代码,需要将它拆分成三个函数,分别是CoreAlg
doPerm
CIBERSORT
CoreAlg
里面有一个核心函数,svm
。至于svm
的作用是什么,在这里先不说,知道他是机器学习中的一个函数就好了。
下面讲解一下CoreAlg
#' Input: signature matrix and mixture file, formatted as specified at http://cibersort.stanford.edu/tutorial.php
#' Output: matrix object containing all results and tabular data written to disk 'CIBERSORT-Results.txt'
#' License: http://cibersort.stanford.edu/CIBERSORT_License.txt
#' Core algorithm
#' @param X cell-specific gene expression
#' @param y mixed expression per sample
#' @export
CoreAlg <- function(X, y){
#try different values of nu
svn_itor <- 3
res <- function(i){
if(i==1){nus <- 0.25}
if(i==2){nus <- 0.5}
if(i==3){nus <- 0.75}
model<-e1071::svm(X,y,type="nu-regression",kernel="linear",nu=nus,scale=F)
model
}
if(Sys.info()['sysname'] == 'Windows') out <- parallel::mclapply(1:svn_itor, res, mc.cores=1) else
out <- parallel::mclapply(1:svn_itor, res, mc.cores=svn_itor)
nusvm <- rep(0,svn_itor)
corrv <- rep(0,svn_itor)
#do cibersort
t <- 1
while(t <= svn_itor) {
weights = t(out[[t]]$coefs) %*% out[[t]]$SV ###out[[t]]$SV:不同nu参数的支持向量 out[[t]]$coefs:不同nu参数的系数。两者乘积
weights[which(weights<0)]<-0##小于0的乘积为0
w<-weights/sum(weights)##相关性
u <- sweep(X,MARGIN=2,w,'*') ###sweep类似于apply,多了一个STATS,代表是运算的参数
k <- apply(u, 1, sum)# 统计每行总和
nusvm[t] <- sqrt((mean((k - y)^2)))#计算标准差
corrv[t] <- cor(k, y)##相关性
t <- t + 1
}
#pick best model
rmses <- nusvm
mn <- which.min(rmses)###取标准差最小的nu值为best model
model <- out[[mn]]
#get and normalize coefficients
q <- t(model$coefs) %*% model$SV
q[which(q<0)]<-0
w <- (q/sum(q))## w 就是计算后的22种免疫细胞的比例
mix_rmse <- rmses[mn]
mix_r <- corrv[mn]##相关性
newList <- list("w" = w, "mix_rmse" = mix_rmse, "mix_r" = mix_r)
}
nus
,nus
的作用也是很重要的。表示了在一个数据集中错误分类的样本数目的上限。它的值介于 0 和 1 之间,越接近 0,模型的复杂度就越高;越接近 1,则模型的复杂度就越低。可以看到这里设置了3个nus。svm
建模。最后的结果都转换到res
中。将res
的结果汇聚到out
里面。这部分是涉及电脑核数的选择的,不需要太深究,理解到结果都到out
里面就好了out
来计算nusvm
得到最佳模型。然后算出该模型中的w
mix_resms
mix_r
。接下来看下doPerm
这个函数,顾名思义与Perm
肯定是有关系。
#' do permutations
#' @param perm Number of permutations
#' @param X cell-specific gene expression
#' @param y mixed expression per sample
#' @export
doPerm <- function(perm, X, Y){
itor <- 1#设置为1,是为了下面的Perm
Ylist <- as.list(data.matrix(Y))
dist <- matrix()#设置一个空文件
while(itor <= perm){
#print(itor)
#random mixture
yr <- as.numeric(Ylist[sample(length(Ylist),dim(X)[1])])
#standardize mixture
yr <- (yr - mean(yr)) / sd(yr)
#run CIBERSORT core algorithm
result <- CoreAlg(X, yr)#运行CoreAlg
mix_r <- result$mix_r##相关性
#store correlation
if(itor == 1) {dist <- mix_r}
else {dist <- rbind(dist, mix_r)}
itor <- itor + 1
}
newList <- list("dist" = dist)
}
这里要分三种情况考虑
result
,mix_r
以及dist=mix_r
result
,mix_r
。但dist=rbind(dist,mix_r)
。自行去学习rbind
这个函数。但这里要重点讲下几句代码
#random mixture
yr <- as.numeric(Ylist[sample(length(Ylist),dim(X)[1])])
这句代码就是根据X中基因的数目在Ylist中随机挑选一样数目的对象。这里的X要记住是参考文件,Y是自己的研究文件。然后Ylist是转化为list的Y。
#standardize mixture
yr <- (yr - mean(yr)) / sd(yr)#进行标准化
理解完前面两个函数
最后就可以来看下CIBERSORT这个函数了
#' Main functions
#' @param sig_matrix file path to gene expression from isolated cells
#' @param mixture_file heterogenous mixed expression
#' @param perm Number of permutations
#' @param QN Perform quantile normalization or not (TRUE/FALSE)
#' @export
CIBERSORT <- function(sig_matrix, mixture_file, perm=0, QN=TRUE){
#read in data
X <- read.table(sig_matrix,header=T,sep="\t",row.names=1,check.names=F)
Y <- read.table(mixture_file, header=T, sep="\t", row.names=1,check.names=F)#这里一般会报错
X <- data.matrix(X)#转化为matrix,主要为了下面好分析
Y <- data.matrix(Y)
#order
X <- X[order(rownames(X)),]#按照列名的字母进行排序
Y <- Y[order(rownames(Y)),]#按照列名的字母进行排序
P <- perm #number of permutations
#anti-log if max < 50 in mixture file
if(max(Y) < 50) {Y <- 2^Y}#很粗略的一种判断数据有没有经过log的方法。进行CIBERSORT的数据是不能log过的
#quantile normalization of mixture file
if(QN == TRUE){
tmpc <- colnames(Y)
tmpr <- rownames(Y)
Y <- preprocessCore::normalize.quantiles(Y)
colnames(Y) <- tmpc
rownames(Y) <- tmpr
}#根据数据有无标准化过来运行代码
#intersect genes
Xgns <- row.names(X)#将X的基因提取出来
Ygns <- row.names(Y)#将Y的基因提取出来
YintX <- Ygns %in% Xgns#Y中取X
Y <- Y[YintX,]#将交集的基因提取出来
XintY <- Xgns %in% row.names(Y)#X中取Y
X <- X[XintY,]#将交集的基因提取出来
#standardize sig matrix
X <- (X - mean(X)) / sd(as.vector(X))#标准化
#empirical null distribution of correlation coefficients
if(P > 0) {nulldist <- sort(doPerm(P, X, Y)$dist)}#P,也就是Perm>0时就能运行doPerm
#print(nulldist)
header <- c('Mixture',colnames(X),"P-value","Correlation","RMSE")
#print(header)
output <- matrix()
itor <- 1
mixtures <- dim(Y)[2]#算出一共Y中有几个样本,Y就是我们的数据集
pval <- 9999
#iterate through mixtures
while(itor <= mixtures){
y <- Y[,itor]#这句代码就是每个样本依次进行计算
#standardize mixture
y <- (y - mean(y)) / sd(y)#zscore归一化,tpm再归一化可以吗,应该是可以的,因为tpm是标准化的一种方法
#run SVR core algorithm
result <- CoreAlg(X, y)##利用svm建模
#get results
w <- result$w ##w 就是计算后的22种免疫细胞的比例
mix_r <- result$mix_r#相关性
mix_rmse <- result$mix_rmse#标准差
#calculate p-value
if(P > 0) {pval <- 1 - (which.min(abs(nulldist - mix_r)) / length(nulldist))}
#print output
out <- c(colnames(Y)[itor],w,pval,mix_r,mix_rmse)
if(itor == 1) {output <- out}
else {output <- rbind(output, out)}
itor <- itor + 1
}
#save results
write.table(rbind(header,output), file="CIBERSORT-Results.txt", sep="\t", row.names=F, col.names=F, quote=F)
#return matrix object containing all results
obj <- rbind(header,output)
obj <- obj[,-1]
obj <- obj[-1,]
obj <- matrix(as.numeric(unlist(obj)),nrow=nrow(obj))
rownames(obj) <- colnames(Y)
colnames(obj) <- c(colnames(X),"P-value","Correlation","RMSE")
obj
}
doPerm
函数得到nulldist
itor <= mixtures
即根据Y的样本数来决定运行的次数。运行的是CoreAlg
函数,得到的是w
mix_r
mix_rmse
。doPerm
,pval <- 9999
doPerm
,得到了nulldist
。pval <- 1 - (which.min(abs(nulldist - mix_r)) / length(nulldist))
。做到这里应该明白doPerm
的意义了吧。是为了最终的这个pval。 Y <- read.table(mixture_file, header=T, sep="\t", row.names=1,check.names=F)#这里一般会报错
#Error in read.table(mixture_file, header = T, sep = "\t", row.names = 1, :'row.names'里不能有重复的名字
这个问题很好解决,主要是由于你输入文件中列名有重复的名字,就是你的基因有重复,那就需要先把mixture_file在外面处理一下再导入。处理的办法可以参考我下面列出的(还有其他很多方法,其主要思想就是把重复的去掉,但又要合理的去除)
Y <- read.table(mixture_file, header=T, sep="\t", check.names=F)
head(Y)
table(duplicated(Y[,1]))
#a=Y[duplicated(Y[,1]),]
#table(rowSums(a[,2:13])>0)
index=order(rowMeans(Y[,2:9]),decreasing = T)
Y=Y[index,]
head(Y)
Y <- Y[!duplicated(Y[,1]),]###去重复基因名
rownames(Y)<-Y[,1]
Y<-Y[,-1]