cellchat在运行到下面几行代码的时有时候会报错，尤其是两个样本合并的时候。
Identify signaling groups based on their functional similarity
cellchat <- computeNetSimilarityPairwise(cellchat, type = "functional")
#> Compute signaling network similarity for datasets 1 2
cellchat <- netEmbedding(cellchat, type = "functional")
#> Manifold learning of the signaling networks for datasets 1 2
cellchat <- netClustering(cellchat, type = "functional")
#> Classification learning of the signaling networks for datasets 1 2
# Visualization in 2D-space
netVisual_embeddingPairwise(cellchat, type = "functional", label.size = 3.5)
#> 2D visualization of signaling networks from datasets 1 2
报错如下，这时候是因为存在NA或无穷值。
image.png
这是一个bug，我们需要修改源码来解决。
我之前是每次用到这个函数就去运行一下修改后的源码。再回来运行这个函数。
这很麻烦且费心费神。尤其是我需要生成markdown文档前预览的时候，这么长的一段代码上下拉动也要费好长时间。
有没有好的办法呢？
当然有！就是
使用source这个函数。
我们可以把修改后的源码源码包装成一个函数，每次需要使用的使用source一下就可以了。
比如我分别把三个需要修改的函数
computeNetSimilarityPairwise
netEmbedding
netClustering
包装后命名为 functional.R 里面包含代码如下
computeNetSimilarity <- function(object, slot.name = "netP", type = c("functional","structural"), k = NULL, thresh = NULL) {
type <- match.arg(type)
prob = methods::slot(object, slot.name)$prob
if (is.null(k)) {
if (dim(prob)[3] <= 25) {
k <- ceiling(sqrt(dim(prob)[3]))
} else {
k <- ceiling(sqrt(dim(prob)[3])) + 1
}
}
if (!is.null(thresh)) {
prob[prob < quantile(c(prob[prob != 0]), thresh)] <- 0
}
if (type == "functional") {
# compute the functional similarity
D_signalings <- matrix(0, nrow = dim(prob)[3], ncol = dim(prob)[3])
S2 <- D_signalings; S3 <- D_signalings;
for (i in 1:(dim(prob)[3]-1)) {
for (j in (i+1):dim(prob)[3]) {
Gi <- (prob[ , ,i] > 0)*1
Gj <- (prob[ , ,j] > 0)*1
S3[i,j] <- sum(Gi * Gj)/sum(Gi+Gj-Gi*Gj,na.rm=TRUE)
}
}
# define the similarity matrix
S3[is.na(S3)] <- 0; S3 <- S3 + t(S3); diag(S3) <- 1
# S_signalings <- S1 *S2
S_signalings <- S3
} else if (type == "structural") {
# compute the structure distance
D_signalings <- matrix(0, nrow = dim(prob)[3], ncol = dim(prob)[3])
for (i in 1:(dim(prob)[3]-1)) {
for (j in (i+1):dim(prob)[3]) {
Gi <- (prob[ , ,i] > 0)*1
Gj <- (prob[ , ,j] > 0)*1
D_signalings[i,j] <- computeNetD_structure(Gi,Gj)
}
}
# define the structure similarity matrix
D_signalings[is.infinite(D_signalings)] <- 0
D_signalings[is.na(D_signalings)] <- 0
D_signalings <- D_signalings + t(D_signalings)
S_signalings <- 1-D_signalings
}
# smooth the similarity matrix using SNN
SNN <- buildSNN(S_signalings, k = k, prune.SNN = 1/15)
Similarity <- as.matrix(S_signalings*SNN)
rownames(Similarity) <- dimnames(prob)[[3]]
colnames(Similarity) <- dimnames(prob)[[3]]
comparison <- "single"
comparison.name <- paste(comparison, collapse = "-")
if (!is.list(methods::slot(object, slot.name)$similarity[[type]]$matrix)) {
methods::slot(object, slot.name)$similarity[[type]]$matrix <- NULL
}
methods::slot(object, slot.name)$similarity[[type]]$matrix[[comparison.name]] <- Similarity
return(object)
}
#' Compute signaling network similarity for any pair of datasets
#'
#' @param object A merged CellChat object
#' @param slot.name the slot name of object that is used to compute centrality measures of signaling networks
#' @param type "functional","structural"
#' @param comparison a numerical vector giving the datasets for comparison
#' @param k the number of nearest neighbors
#' @param thresh the fraction (0 to 0.25) of interactions to be trimmed before computing network similarity
#' @importFrom methods slot
#'
#' @return
#' @export
#'
computeNetSimilarityPairwise <- function(object, slot.name = "netP", type = c("functional","structural"), comparison = NULL, k = NULL, thresh = NULL) {
type <- match.arg(type)
if (is.null(comparison)) {
comparison <- 1:length(unique(object@meta$datasets))
}
cat("Compute signaling network similarity for datasets", as.character(comparison), '\n')
comparison.name <- paste(comparison, collapse = "-")
net <- list()
signalingAll <- c()
object.net.nameAll <- c()
# 1:length(setdiff(names(methods::slot(object, slot.name)), "similarity"))
for (i in 1:length(comparison)) {
object.net <- methods::slot(object, slot.name)[[comparison[i]]]
object.net.name <- names(methods::slot(object, slot.name))[comparison[i]]
object.net.nameAll <- c(object.net.nameAll, object.net.name)
net[[i]] = object.net$prob
signalingAll <- c(signalingAll, paste0(dimnames(net[[i]])[[3]], "--", object.net.name))
# signalingAll <- c(signalingAll, dimnames(net[[i]])[[3]])
}
names(net) <- object.net.nameAll
net.dim <- sapply(net, dim)[3,]
nnet <- sum(net.dim)
position <- cumsum(net.dim); position <- c(0,position)
if (is.null(k)) {
if (nnet <= 25) {
k <- ceiling(sqrt(nnet))
} else {
k <- ceiling(sqrt(nnet)) + 1
}
}
if (!is.null(thresh)) {
for (i in 1:length(net)) {
neti <- net[[i]]
neti[neti < quantile(c(neti[neti != 0]), thresh)] <- 0
net[[i]] <- neti
}
}
if (type == "functional") {
# compute the functional similarity
S3 <- matrix(0, nrow = nnet, ncol = nnet)
for (i in 1:nnet) {
for (j in 1:nnet) {
idx.i <- which(position - i >= 0)[1]
idx.j <- which(position - j >= 0)[1]
net.i <- net[[idx.i-1]]
net.j <- net[[idx.j-1]]
Gi <- (net.i[ , ,i-position[idx.i-1]] > 0)*1
Gj <- (net.j[ , ,j-position[idx.j-1]] > 0)*1
S3[i,j] <- sum(Gi * Gj)/sum(Gi+Gj-Gi*Gj,na.rm=TRUE)
}
}
# define the similarity matrix
S3[is.na(S3)] <- 0; diag(S3) <- 1
S_signalings <- S3
} else if (type == "structural") {
# compute the structure distance
D_signalings <- matrix(0, nrow = nnet, ncol = nnet)
for (i in 1:nnet) {
for (j in 1:nnet) {
idx.i <- which(position - i >= 0)[1]
idx.j <- which(position - j >= 0)[1]
net.i <- net[[idx.i-1]]
net.j <- net[[idx.j-1]]
Gi <- (net.i[ , ,i-position[idx.i-1]] > 0)*1
Gj <- (net.j[ , ,j-position[idx.j-1]] > 0)*1
D_signalings[i,j] <- computeNetD_structure(Gi,Gj)
}
}
# define the structure similarity matrix
D_signalings[is.infinite(D_signalings)] <- 0
D_signalings[is.na(D_signalings)] <- 0
S_signalings <- 1-D_signalings
}
# smooth the similarity matrix using SNN
SNN <- buildSNN(S_signalings, k = k, prune.SNN = 1/15)
Similarity <- as.matrix(S_signalings*SNN)
rownames(Similarity) <- signalingAll
colnames(Similarity) <- rownames(Similarity)
if (!is.list(methods::slot(object, slot.name)$similarity[[type]]$matrix)) {
methods::slot(object, slot.name)$similarity[[type]]$matrix <- NULL
}
# methods::slot(object, slot.name)$similarity[[type]]$matrix <- Similarity
methods::slot(object, slot.name)$similarity[[type]]$matrix[[comparison.name]] <- Similarity
return(object)
}
#' Manifold learning of the signaling networks based on their similarity
#'
#' @param object CellChat object
#' @param slot.name the slot name of object that is used to compute centrality measures of signaling networks
#' @param type "functional","structural"
#' @param comparison a numerical vector giving the datasets for comparison. No need to define for a single dataset. Default are all datasets when object is a merged object
#' @param k the number of nearest neighbors in running umap
#' @param pathway.remove a range of the number of patterns
#' @importFrom methods slot
#' @return
#' @export
#'
#' @examples
#'
#'
#'
#'
#'
#'
#'
netEmbedding <- function(object, slot.name = "netP", type = c("functional","structural"), comparison = NULL, pathway.remove = NULL, k = NULL) {
if (object@options$mode == "single") {
comparison <- "single"
cat("Manifold learning of the signaling networks for a single dataset", '\n')
} else if (object@options$mode == "merged") {
if (is.null(comparison)) {
comparison <- 1:length(unique(object@meta$datasets))
}
cat("Manifold learning of the signaling networks for datasets", as.character(comparison), '\n')
}
comparison.name <- paste(comparison, collapse = "-")
Similarity <- methods::slot(object, slot.name)$similarity[[type]]$matrix[[comparison.name]]
if (is.null(pathway.remove)) {
pathway.remove <- rownames(Similarity)[which(colSums(Similarity) == 1)]
}
if (length(pathway.remove) > 0) {
pathway.remove.idx <- which(rownames(Similarity) %in% pathway.remove)
Similarity <- Similarity[-pathway.remove.idx, -pathway.remove.idx]
}
if (is.null(k)) {
k <- ceiling(sqrt(dim(Similarity)[1])) + 1
}
options(warn = -1)
# dimension reduction
Y <- runUMAP(Similarity, min.dist = 0.3, n.neighbors = k)
if (!is.list(methods::slot(object, slot.name)$similarity[[type]]$dr)) {
methods::slot(object, slot.name)$similarity[[type]]$dr <- NULL
}
methods::slot(object, slot.name)$similarity[[type]]$dr[[comparison.name]] <- Y
return(object)
}
#' Classification learning of the signaling networks
#'
#' @param object CellChat object
#' @param slot.name the slot name of object that is used to compute centrality measures of signaling networks
#' @param type "functional","structural"
#' @param comparison a numerical vector giving the datasets for comparison. No need to define for a single dataset. Default are all datasets when object is a merged object
#' @param k the number of signaling groups when running kmeans
#' @param methods the methods for clustering: "kmeans" or "spectral"
#' @param do.plot whether showing the eigenspectrum for inferring number of clusters; Default will save the plot
#' @param fig.id add a unique figure id when saving the plot
#' @param do.parallel whether doing parallel when inferring the number of signaling groups when running kmeans
#' @param nCores number of workers when doing parallel
#' @param k.eigen the number of eigenvalues used when doing spectral clustering
#' @importFrom methods slot
#' @importFrom future nbrOfWorkers plan
#' @importFrom future.apply future_sapply
#' @importFrom pbapply pbsapply
#' @return
#' @export
#'
#' @examples
netClustering <- function(object, slot.name = "netP", type = c("functional","structural"), comparison = NULL, k = NULL, methods = "kmeans", do.plot = TRUE, fig.id = NULL, do.parallel = TRUE, nCores = 4, k.eigen = NULL) {
type <- match.arg(type)
if (object@options$mode == "single") {
comparison <- "single"
cat("Classification learning of the signaling networks for a single dataset", '\n')
} else if (object@options$mode == "merged") {
if (is.null(comparison)) {
comparison <- 1:length(unique(object@meta$datasets))
}
cat("Classification learning of the signaling networks for datasets", as.character(comparison), '\n')
}
comparison.name <- paste(comparison, collapse = "-")
Y <- methods::slot(object, slot.name)$similarity[[type]]$dr[[comparison.name]]
Y[is.na(Y)] <- 0
data.use <- Y
if (methods == "kmeans") {
if (!is.null(k)) {
clusters = kmeans(data.use,k,nstart=10)$cluster
} else {
N <- nrow(data.use)
kRange <- seq(2,min(N-1, 10),by = 1)
if (do.parallel) {
future::plan("multiprocess", workers = nCores)
options(future.globals.maxSize = 1000 * 1024^2)
}
my.sapply <- ifelse(
test = future::nbrOfWorkers() == 1,
yes = pbapply::pbsapply,
no = future.apply::future_sapply
)
results = my.sapply(
X = 1:length(kRange),
FUN = function(x) {
idents <- kmeans(data.use,kRange[x],nstart=10)$cluster
clusIndex <- idents
#adjMat0 <- as.numeric(outer(clusIndex, clusIndex, FUN = "==")) - outer(1:N, 1:N, "==")
adjMat0 <- Matrix::Matrix(as.numeric(outer(clusIndex, clusIndex, FUN = "==")), nrow = N, ncol = N)
return(list(adjMat = adjMat0, ncluster = length(unique(idents))))
},
simplify = FALSE
)
adjMat <- lapply(results, "[[", 1)
CM <- Reduce('+', adjMat)/length(kRange)
res <- computeEigengap(as.matrix(CM))
numCluster <- res$upper_bound
clusters = kmeans(data.use,numCluster,nstart=10)$cluster
if (do.plot) {
gg <- res$gg.obj
ggsave(filename= paste0("estimationNumCluster_",fig.id,"_",type,"_dataset_",comparison.name,".pdf"), plot=gg, width = 3.5, height = 3, units = 'in', dpi = 300)
}
}
} else if (methods == "spectral") {
A <- as.matrix(data.use)
D <- apply(A, 1, sum)
L <- diag(D)-A # unnormalized version
L <- diag(D^-0.5)%*%L%*% diag(D^-0.5) # normalized version
evL <- eigen(L,symmetric=TRUE) # evL$values is decreasing sorted when symmetric=TRUE
# pick the first k first k eigenvectors (corresponding k smallest) as data points in spectral space
plot(rev(evL$values)[1:30])
Z <- evL$vectors[,(ncol(evL$vectors)-k.eigen+1):ncol(evL$vectors)]
clusters = kmeans(Z,k,nstart=20)$cluster
}
if (!is.list(methods::slot(object, slot.name)$similarity[[type]]$group)) {
methods::slot(object, slot.name)$similarity[[type]]$group <- NULL
}
methods::slot(object, slot.name)$similarity[[type]]$group[[comparison.name]] <- clusters
return(object)
}
这样我在这几行代码前加一句
source("functional.R")
就可以了
代码如下
source("functional.R")
cellchat <- computeNetSimilarityPairwise(cellchat, type = "functional")
#> Compute signaling network similarity for datasets 1 2
cellchat <- netEmbedding(cellchat, type = "functional")
#> Manifold learning of the signaling networks for datasets 1 2
cellchat <- netClustering(cellchat, type = "functional")
#> Classification learning of the signaling networks for datasets 1 2
# Visualization in 2D-space
netVisual_embeddingPairwise(cellchat, type = "functional", label.size = 3.5)
#> 2D visualization of signaling networks from datasets 1 2
出图如下：
image.png