cellchat 报错解决Error in do_one( nmeth):外接函数调用时不能有NA/NaN/Inf(arg1)

1. 报错如下

image.png

2. 解决如下:对比修改函数源代码

 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)
+ }
> #   报错 找到pullrequest 修改后源代码运行 也不对 逐个函数运行
> cellchat <- computeNetSimilarity(cellchat, type = "functional")
> #' @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)
+ }
> #' @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)
+ }
> cellchat <- netEmbedding(cellchat, type = "functional")
Manifold learning of the signaling networks for a single dataset 
C:\Users\zzu\AppData\Local\R-MINI~1\envs\R-RETI~1\lib\site-packages\umap\umap_.py:133: UserWarning: A large number of your vertices were disconnected from the manifold.
Disconnection_distance = 1 has removed 142 edges.
It has fully disconnected 3 vertices.
You might consider using find_disconnected_points() to find and remove these points from your data.
Use umap.utils.disconnected_vertices() to identify them.
  f"A large number of your vertices were disconnected from the manifold.\n"
> #' @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)
+ }
> #> Manifold learning of the signaling networks for a single dataset
> cellchat <- netClustering(cellchat, type = "functional")
Classification learning of the signaling networks for a single dataset 
> #> Classification learning of the signaling networks for a single dataset
> # Visualization in 2D-space
> netVisual_embedding(cellchat, type = "functional", label.size = 3.5)
> cellchat <- computeNetSimilarity(cellchat, type = "structural")
> cellchat <- netEmbedding(cellchat, type = "structural")
Manifold learning of the signaling networks for a single dataset 
> #> Manifold learning of the signaling networks for a single dataset
> cellchat <- netClustering(cellchat, type = "structural")
Classification learning of the signaling networks for a single dataset 
> #> Classification learning of the signaling networks for a single dataset
> # Visualization in 2D-space
> netVisual_embedding(cellchat, type = "structural", label.size = 3.5)
  1. 正确出图如下


    image.png

你可能感兴趣的:(cellchat 报错解决Error in do_one( nmeth):外接函数调用时不能有NA/NaN/Inf(arg1))