diff --git a/DESCRIPTION b/DESCRIPTION index fa8b685..a51e168 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -12,7 +12,7 @@ LazyData: TRUE Imports: future, future.apply, - pbapply, + progressr, irlba, NMF (>= 0.23.0), ggalluvial, diff --git a/NAMESPACE b/NAMESPACE index b796d88..da9b6cf 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -167,7 +167,6 @@ importFrom(dplyr,starts_with) importFrom(dplyr,summarise) importFrom(dplyr,summarize) importFrom(dplyr,top_n) -importFrom(future,nbrOfWorkers) importFrom(future,plan) importFrom(future.apply,future_sapply) importFrom(ggnetwork,geom_nodetext_repel) @@ -228,7 +227,7 @@ importFrom(methods,setClass) importFrom(methods,setClassUnion) importFrom(methods,slot) importFrom(patchwork,wrap_plots) -importFrom(pbapply,pbsapply) +importFrom(progressr,progressor) importFrom(plyr,mapvalues) importFrom(reshape2,melt) importFrom(reticulate,import) diff --git a/R/analysis.R b/R/analysis.R index a455f61..dafb898 100644 --- a/R/analysis.R +++ b/R/analysis.R @@ -190,10 +190,9 @@ netAnalysis_contribution <- function(object, signaling, signaling.name = NULL, s #' @param net compute the centrality measures on a specific signaling network given by a 2 or 3 dimemsional array net #' @param net.name a character vector giving the name of signaling networks #' @param thresh threshold of the p-value for determining significant interaction -#' @importFrom future nbrOfWorkers #' @importFrom methods slot #' @importFrom future.apply future_sapply -#' @importFrom pbapply pbsapply +#' @importFrom progressr progressor #' #' @return #' @export @@ -211,17 +210,16 @@ netAnalysis_computeCentrality <- function(object = NULL, slot.name = "netP", net } if (length(dim(net)) == 3) { nrun <- dim(net)[3] - my.sapply <- ifelse( - test = future::nbrOfWorkers() == 1, - yes = pbapply::pbsapply, - no = future.apply::future_sapply - ) - centr.all = my.sapply( + p <- progressr::progressor(nrun) + centr.all <- future.apply::future_sapply( X = 1:nrun, FUN = function(x) { + Sys.sleep(1/nrun) + p(sprintf("%g of %g", x, nrun)) # Use with_progress() to see progress bar in client-side net0 <- net[ , , x] return(computeCentralityLocal(net0)) }, + future.seed = TRUE, simplify = FALSE ) } else { @@ -705,9 +703,9 @@ netEmbedding <- function(object, slot.name = "netP", type = c("functional","stru #' @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 plan #' @importFrom future.apply future_sapply -#' @importFrom pbapply pbsapply +#' @importFrom progressr progressor #' @return #' @export #' @@ -733,28 +731,35 @@ netClustering <- function(object, slot.name = "netP", type = c("functional","str } else { N <- nrow(data.use) kRange <- seq(2,min(N-1, 10),by = 1) + nCores <- as.integer(nCores) if (do.parallel) { - future::plan("multisession", workers = nCores) + if (.Platform$OS.type == "windows") { + future::plan("multisession", workers = nCores) + } else { + future::plan("multicore", workers = nCores) + } options(future.globals.maxSize = 1000 * 1024^2) + } else { + future::plan("sequential") } - my.sapply <- ifelse( - test = future::nbrOfWorkers() == 1, - yes = pbapply::pbsapply, - no = future.apply::future_sapply - ) - results = my.sapply( - X = 1:length(kRange), + message(sprintf("future plan is '%s'", as.character(attr(future::plan(), "call"))[2])) + kN <- length(kRange) + p <- progressr::progressor(kN) + results <- future.apply::future_sapply( + X = 1:kN, FUN = function(x) { - idents <- kmeans(data.use,kRange[x],nstart=10)$cluster + Sys.sleep(1/kN) + p(sprintf("%g of %g", x, kN)) # Use with_progress() to see progress bar in client-side + 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)))) }, + future.seed = TRUE, simplify = FALSE ) adjMat <- lapply(results, "[[", 1) - CM <- Reduce('+', adjMat)/length(kRange) + CM <- Reduce('+', adjMat)/kN res <- computeEigengap(as.matrix(CM)) numCluster <- res$upper_bound clusters = kmeans(data.use,numCluster,nstart=10)$cluster @@ -1114,7 +1119,7 @@ rankNet <- function(object, slot.name = "netP", measure = c("weight","count"), m } gg <- ggplot(df, aes(x=name, y=contribution.scaled)) + geom_bar(stat="identity",width = bar.w) + - theme_classic() + theme(axis.text=element_text(size=font.size),axis.text.x = element_blank(), axis.ticks.x = element_blank(), axis.title.y = element_text(size=10)) + + theme_classic() + theme(axis.text=element_text(size=font.size),axis.text.x = element_blank(), axis.ticks.x = element_blank(), axis.title.y = element_text(size=font.size)) + xlab("") + ylab(ylabel) + coord_flip()#+ if (!is.null(title)) { gg <- gg + ggtitle(title)+ theme(plot.title = element_text(hjust = 0.5)) diff --git a/R/modeling.R b/R/modeling.R index c100b7f..2339af0 100644 --- a/R/modeling.R +++ b/R/modeling.R @@ -43,9 +43,8 @@ #' @param n Parameter in Hill function #' #' -#' @importFrom future nbrOfWorkers #' @importFrom future.apply future_sapply -#' @importFrom pbapply pbsapply +#' @importFrom progressr progressor #' @importFrom stats aggregate #' @importFrom Matrix crossprod #' @importFrom utils txtProgressBar setTxtProgressBar @@ -61,7 +60,8 @@ #' @export #' computeCommunProb <- function(object, type = c("triMean", "truncatedMean","thresholdedMean", "median"), trim = 0.1, LR.use = NULL, raw.use = TRUE, population.size = FALSE, - distance.use = TRUE, interaction.range = 250, scale.distance = 0.01, k.min = 10, contact.dependent = TRUE, contact.range = NULL, contact.knn.k = NULL, contact.dependent.forced = FALSE, do.symmetric = TRUE, + distance.use = TRUE, interaction.range = 250, scale.distance = 0.01, k.min = 10, + contact.dependent = TRUE, contact.range = NULL, contact.knn.k = NULL, contact.dependent.forced = FALSE, do.symmetric = TRUE, nboot = 100, seed.use = 1L, Kh = 0.5, n = 1) { type <- match.arg(type) cat(type, "is used for calculating the average gene expression per cell group.", "\n") @@ -88,11 +88,6 @@ computeCommunProb <- function(object, type = c("triMean", "truncatedMean","thres } complex_input <- object@DB$complex cofactor_input <- object@DB$cofactor - my.sapply <- ifelse( - test = future::nbrOfWorkers() == 1, - yes = sapply, - no = future.apply::future_sapply - ) ptm = Sys.time() @@ -205,14 +200,17 @@ computeCommunProb <- function(object, type = c("triMean", "truncatedMean","thres set.seed(seed.use) permutation <- replicate(nboot, sample.int(nC, size = nC)) - data.use.avg.boot <- my.sapply( + p <- progressr::progressor(nboot) + data.use.avg.boot <- future.apply::future_sapply( X = 1:nboot, FUN = function(nE) { + p() groupboot <- group[permutation[, nE]] data.use.avgB <- aggregate(t(data.use), list(groupboot), FUN = FunMean) data.use.avgB <- t(data.use.avgB[,-1]) return(data.use.avgB) }, + future.seed = TRUE, simplify = FALSE ) pb <- txtProgressBar(min = 0, max = nLR, style = 3, file = stderr()) @@ -257,10 +255,11 @@ computeCommunProb <- function(object, type = c("triMean", "truncatedMean","thres Pnull <- as.vector(Pnull) - #Pboot <- foreach(nE = 1:nboot) %dopar% { - Pboot <- sapply( + p <- progressr::progressor(nboot) + Pboot <- future.apply::future_sapply( X = 1:nboot, FUN = function(nE) { + p() data.use.avgB <- data.use.avg.boot[[nE]] dataLavgB <- computeExpr_LR(geneL[i], data.use.avgB, complex_input) dataRavgB <- computeExpr_LR(geneR[i], data.use.avgB, complex_input) @@ -518,20 +517,17 @@ computeAveExpr <- function(object, features = NULL, group.by = NULL, type = c("t #' @param complex the names of complex #' @return #' @importFrom dplyr select starts_with -#' @importFrom future nbrOfWorkers #' @importFrom future.apply future_sapply -#' @importFrom pbapply pbsapply +#' @importFrom progressr progressor #' @export computeExpr_complex <- function(complex_input, data.use, complex) { Rsubunits <- complex_input[complex,] %>% dplyr::select(starts_with("subunit")) - my.sapply <- ifelse( - test = future::nbrOfWorkers() == 1, - yes = sapply, - no = future.apply::future_sapply - ) - data.complex = my.sapply( - X = 1:nrow(Rsubunits), + nrun <- nrow(Rsubunits) + p <- progressr::progressor(nrun) + data.complex <- future.apply::future_sapply( + X = 1:nrun, FUN = function(x) { + p() RsubunitsV <- unlist(Rsubunits[x,], use.names = F) RsubunitsV <- RsubunitsV[RsubunitsV != ""] return(geometricMean(data.use[RsubunitsV, , drop = FALSE])) @@ -549,20 +545,17 @@ computeExpr_complex <- function(complex_input, data.use, complex) { # @param FunMean the function for computing mean expression per group # @return # @importFrom dplyr select starts_with -# @importFrom future nbrOfWorkers # @importFrom future.apply future_sapply -# @importFrom pbapply pbsapply -# #' @export +# @importFrom progressr progressor +# @export .computeExprGroup_complex <- function(complex_input, data.use, complex, group, FunMean) { Rsubunits <- complex_input[complex,] %>% dplyr::select(starts_with("subunit")) - my.sapply <- ifelse( - test = future::nbrOfWorkers() == 1, - yes = pbapply::pbsapply, - no = future.apply::future_sapply - ) - data.complex = my.sapply( - X = 1:nrow(Rsubunits), + nrun <- nrow(Rsubunits) + p <- progressr::progressor(nrun) + data.complex <- future.apply::future_sapply( + X = 1:nrun, FUN = function(x) { + p() RsubunitsV <- unlist(Rsubunits[x,], use.names = F) RsubunitsV <- RsubunitsV[RsubunitsV != ""] RsubunitsV <- intersect(RsubunitsV, rownames(data.use)) @@ -586,8 +579,8 @@ computeExpr_complex <- function(complex_input, data.use, complex) { #' @param geneLR a char vector giving a set of ligands or receptors #' @param data.use data matrix (row are genes and columns are cells or cell groups) #' @param complex_input the complex_input from CellChatDB -# #' @param group a factor defining the cell groups; If NULL, compute the expression of ligands or receptors in individual cells; otherwise, compute the average expression of ligands or receptors per cell group -# #' @param FunMean the function for computing average expression per cell group +#' @param group a factor defining the cell groups; If NULL, compute the expression of ligands or receptors in individual cells; otherwise, compute the average expression of ligands or receptors per cell group +#' @param FunMean the function for computing average expression per cell group #' @return #' @export computeExpr_LR <- function(geneLR, data.use, complex_input){ @@ -614,9 +607,8 @@ computeExpr_LR <- function(geneLR, data.use, complex_input){ #' @param pairLRsig a data frame giving ligand-receptor interactions #' @param type when type == "A", computing expression of co-activation receptor; when type == "I", computing expression of co-inhibition receptor. #' @return -#' @importFrom future nbrOfWorkers #' @importFrom future.apply future_sapply -#' @importFrom pbapply pbsapply +#' @importFrom progressr progressor #' @export computeExpr_coreceptor <- function(cofactor_input, data.use, pairLRsig, type = c("A", "I")) { type <- match.arg(type) @@ -627,16 +619,14 @@ computeExpr_coreceptor <- function(cofactor_input, data.use, pairLRsig, type = c } index.coreceptor <- which(!is.na(coreceptor.all) & coreceptor.all != "") if (length(index.coreceptor) > 0) { - my.sapply <- ifelse( - test = future::nbrOfWorkers() == 1, - yes = sapply, - no = future.apply::future_sapply - ) coreceptor <- coreceptor.all[index.coreceptor] coreceptor.ind <- cofactor_input[coreceptor, grepl("cofactor" , colnames(cofactor_input) )] - data.coreceptor.ind = my.sapply( - X = 1:nrow(coreceptor.ind), + nrun <- nrow(coreceptor.ind) + p <- progressr::progressor(nrun) + data.coreceptor.ind <- future.apply::future_sapply( + X = 1:nrun, FUN = function(x) { + p() coreceptor.indV <- unlist(coreceptor.ind[x,], use.names = F) coreceptor.indV <- coreceptor.indV[coreceptor.indV != ""] coreceptor.indV <- intersect(coreceptor.indV, rownames(data.use)) @@ -667,10 +657,9 @@ computeExpr_coreceptor <- function(cofactor_input, data.use, pairLRsig, type = c # @param group a factor defining the cell groups # @param FunMean the function for computing mean expression per group # @return -# @importFrom future nbrOfWorkers # @importFrom future.apply future_sapply -# @importFrom pbapply pbsapply -# #' @export +# @importFrom progressr progressor +# @export .computeExprGroup_coreceptor <- function(cofactor_input, data.use, pairLRsig, type = c("A", "I"), group, FunMean) { type <- match.arg(type) if (type == "A") { @@ -680,16 +669,14 @@ computeExpr_coreceptor <- function(cofactor_input, data.use, pairLRsig, type = c } index.coreceptor <- which(!is.na(coreceptor.all) & coreceptor.all != "") if (length(index.coreceptor) > 0) { - my.sapply <- ifelse( - test = future::nbrOfWorkers() == 1, - yes = pbapply::pbsapply, - no = future.apply::future_sapply - ) coreceptor <- coreceptor.all[index.coreceptor] coreceptor.ind <- cofactor_input[coreceptor, grepl("cofactor" , colnames(cofactor_input) )] - data.coreceptor.ind = my.sapply( - X = 1:nrow(coreceptor.ind), + nrun <- nrow(coreceptor.ind) + p <- progressr::progressor(nrun) + data.coreceptor.ind <- future.apply::future_sapply( + X = 1:nrun, FUN = function(x) { + p() coreceptor.indV <- unlist(coreceptor.ind[x,], use.names = F) coreceptor.indV <- coreceptor.indV[coreceptor.indV != ""] coreceptor.indV <- intersect(coreceptor.indV, rownames(data.use)) @@ -697,7 +684,6 @@ computeExpr_coreceptor <- function(cofactor_input, data.use, pairLRsig, type = c data.avg <- aggregate(t(data.use[coreceptor.indV,]), list(group), FUN = FunMean) data.avg <- t(data.avg[,-1]) return(apply(1 + data.avg, 2, prod)) - # return(1 + apply(data.avg, 2, mean)) } else if (length(coreceptor.indV) == 1) { data.avg <- aggregate(matrix(data.use[coreceptor.indV,], ncol = 1), list(group), FUN = FunMean) data.avg <- t(data.avg[,-1]) @@ -787,10 +773,10 @@ computeExprGroup_antagonist <- function(data.use, pairLRsig, cofactor_input, gro #' @param data.use data matrix #' @param cofactor_input the cofactor_input from CellChatDB #' @param pairLRsig the L-R interactions -# #' @param group a factor defining the cell groups +#' @param group a factor defining the cell groups #' @param index.agonist the index of agonist in the database #' @param Kh a parameter in Hill function -# #' @param FunMean the function for computing mean expression per group +#' @param FunMean the function for computing mean expression per group #' @param n Hill coefficient #' @return #' @export @@ -823,11 +809,11 @@ computeExpr_agonist <- function(data.use, pairLRsig, cofactor_input, index.agoni #' @param data.use data matrix #' @param cofactor_input the cofactor_input from CellChatDB #' @param pairLRsig the L-R interactions -# #' @param group a factor defining the cell groups +#' @param group a factor defining the cell groups #' @param index.antagonist the index of antagonist in the database #' @param Kh a parameter in Hill function #' @param n Hill coefficient -# #' @param FunMean the function for computing mean expression per group +#' @param FunMean the function for computing mean expression per group #' @return #' @export #' @importFrom stats aggregate @@ -885,7 +871,7 @@ triMean <- function(x, na.rm = TRUE) { #' @param na.rm whether remove na #' @return #' @importFrom Matrix nnzero -# #' @export +#' @export thresholdedMean <- function(x, trim = 0.1, na.rm = TRUE) { percent <- Matrix::nnzero(x)/length(x) if (percent < trim) { diff --git a/R/utilities.R b/R/utilities.R index fdc4a59..ca282b6 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -363,9 +363,8 @@ subsetData <- function(object, features = NULL) { #' @param do.DE Whether to perform differential expression analysis. By default do.DE = TRUE; When do.DE = FALSE, selecting over-expressed genes that are expressed in more than `min.cells` cells. #' @param do.fast If do.fast = TRUE, then perform a ultra-fast Wilcoxon test using presto package; otherwise using stats package. These two methods produce different logFC values, and the presto::wilcoxauc method gives smaller values. #' @param min.cells the minmum number of expressed cells required for the genes that are considered for cell-cell communication analysis -#' @importFrom future nbrOfWorkers -#' @importFrom pbapply pbsapply #' @importFrom future.apply future_sapply +#' @importFrom progressr progressor #' @importFrom stats sd wilcox.test p.adjust #' #' @return A CellChat object or a data frame. If returning a CellChat object, two new elements named 'features.name' and paste0(features.name, ".info") will be added into the list `object@var.features` @@ -495,13 +494,6 @@ identifyOverExpressedGenes <- function(object, data.use = NULL, group.by = NULL, object@var.features[[features.name]] <- markers.all } else { - - my.sapply <- ifelse( - test = future::nbrOfWorkers() == 1, - yes = pbapply::pbsapply, - no = future.apply::future_sapply - ) - mean.fxn <- function(x) { return(log(x = mean(x = expm1(x = x)) + 1)) } @@ -561,16 +553,18 @@ identifyOverExpressedGenes <- function(object, data.use = NULL, group.by = NULL, data1 <- data.use[features, cell.use1, drop = FALSE] data2 <- data.use[features, cell.use2, drop = FALSE] + nrun <- nrow(x = data1) + p <- progressr::progressor(nrun) pvalues <- unlist( - x = my.sapply( - X = 1:nrow(x = data1), + x <- future.apply::future_sapply( + X = 1:nrun, FUN = function(x) { - # return(wilcox.test(data1[x, ], data2[x, ], alternative = "greater")$p.value) + Sys.sleep(1/nrun) + p(sprintf("%g of %g in %s", x, nrun, level.use[i])) # Use with_progress() to see progress bar in client-side return(wilcox.test(data1[x, ], data2[x, ])$p.value) } ) ) - pval.adj = stats::p.adjust( p = pvalues, method = "bonferroni", @@ -634,9 +628,8 @@ identifyOverExpressedGenes <- function(object, data.use = NULL, group.by = NULL, #' @param features.name a char name used for storing the over-expressed ligands and receptors in `object@var.features[[paste0(features.name, ".LR")]]` #' @param features a vector of features to use. default use all over-expressed genes in `object@var.features[[features.name]]` #' @param return.object whether returning a CellChat object. If FALSE, it will return a data frame containing over-expressed ligands and (complex) receptors associated with each cell group -#' @importFrom future nbrOfWorkers #' @importFrom future.apply future_sapply -#' @importFrom pbapply pbsapply +#' @importFrom progressr progressor #' @importFrom dplyr select #' #' @return A CellChat object or a data frame. If returning a CellChat object, a new element named paste0(features.name, ".LR") will be added into the list `object@var.features` @@ -664,25 +657,25 @@ identifyOverExpressedLigandReceptor <- function(object, features.name = "feature markers.all <- subset(markers.all, subset = features %in% features.use) } - my.sapply <- ifelse( - test = future::nbrOfWorkers() == 1, - yes = pbapply::pbsapply, - no = future.apply::future_sapply - ) complexSubunits <- complex_input[, grepl("subunit" , colnames(complex_input))] markers.all.new <- data.frame() for (i in 1:nrow(markers.all)) { - if (markers.all$features[i] %in% LR.use) { + features <- markers.all$features[i] + if (features %in% LR.use) { markers.all.new <- rbind(markers.all.new, markers.all[i, , drop = FALSE]) } else { + nrun <- nrow(complexSubunits) + p <- progressr::progressor(nrun) index.sig <- unlist( - x = my.sapply( - X = 1:nrow(complexSubunits), + x <- future.apply::future_sapply( + X = 1:nrun, FUN = function(x) { + Sys.sleep(1/nrun) + p(sprintf("%g of %g in %s", x, nrun, features)) # Use with_progress() to see progress bar in client-side complexsubunitsV <- unlist(complexSubunits[x,], use.names = F) complexsubunitsV <- complexsubunitsV[complexsubunitsV != ""] - if (markers.all$features[i] %in% complexsubunitsV) { + if (features %in% complexsubunitsV) { return(x) } } @@ -718,9 +711,8 @@ identifyOverExpressedLigandReceptor <- function(object, features.name = "feature #' #' variable.both = FALSE will only require that either ligand or receptor from one pair is over-expressed, leading to more over-expressed ligand-receptor interactions (pairs) for further analysis. #' @param return.object whether returning a CellChat object. If FALSE, it will return a data frame containing the over-expressed ligand-receptor pairs -#' @importFrom future nbrOfWorkers #' @importFrom future.apply future_sapply -#' @importFrom pbapply pbsapply +#' @importFrom progressr progressor #' @importFrom dplyr select #' #' @return A CellChat object or a data frame. If returning a CellChat object, a new element named 'LRsig' will be added into the list `object@LR` @@ -742,16 +734,15 @@ identifyOverExpressedInteractions <- function(object, features.name = "features" interaction_input <- DB$interaction complex_input <- DB$complex - my.sapply <- ifelse( - test = future::nbrOfWorkers() == 1, - yes = pbapply::pbsapply, - no = future.apply::future_sapply - ) complexSubunits <- complex_input[, grepl("subunit" , colnames(complex_input))] + nrun <- nrow(complexSubunits) + p <- progressr::progressor(nrun) index.sig <- unlist( - x = my.sapply( - X = 1:nrow(complexSubunits), + x <- future.apply::future_sapply( + X = 1:nrun, FUN = function(x) { + Sys.sleep(1/nrun) + p(sprintf("(Step 1) %g of %g", x, nrun)) # Use with_progress() to see progress bar in client-side complexsubunitsV <- unlist(complexSubunits[x,], use.names = F) complexsubunitsV <- complexsubunitsV[complexsubunitsV != ""] if (length(intersect(complexsubunitsV, features.sig)) > 0 & all(complexsubunitsV %in% gene.use)) { @@ -762,10 +753,14 @@ identifyOverExpressedInteractions <- function(object, features.name = "features" ) complexSubunits.sig <- complexSubunits[index.sig,] + nrun <- nrow(complexSubunits) + p <- progressr::progressor(nrun) index.use <- unlist( - x = my.sapply( - X = 1:nrow(complexSubunits), + x <- future.apply::future_sapply( + X = 1:nrun, FUN = function(x) { + Sys.sleep(1/nrun) + p(sprintf("(Step 2) %g of %g", x, nrun)) # Use with_progress() to see progress bar in client-side complexsubunitsV <- unlist(complexSubunits[x,], use.names = F) complexsubunitsV <- complexsubunitsV[complexsubunitsV != ""] if (all(complexsubunitsV %in% gene.use)) { @@ -778,11 +773,15 @@ identifyOverExpressedInteractions <- function(object, features.name = "features" pairLR <- select(interaction_input, ligand, receptor) + nrun <- nrow(pairLR) + p <- progressr::progressor(nrun) if (variable.both) { index.sig <- unlist( - x = my.sapply( - X = 1:nrow(pairLR), + x <- future.apply::future_sapply( + X = 1:nrun, FUN = function(x) { + Sys.sleep(1/nrun) + p(sprintf("(Step 3) %g of %g", x, nrun)) # Use with_progress() to see progress bar in client-side if (all(unlist(pairLR[x,], use.names = F) %in% c(features.sig, rownames(complexSubunits.sig)))) { return(x) } @@ -791,10 +790,11 @@ identifyOverExpressedInteractions <- function(object, features.name = "features" ) } else { index.sig <- unlist( - x = my.sapply( - X = 1:nrow(pairLR), + x <- future.apply::future_sapply( + X = 1:nrun, FUN = function(x) { - # if (all(unlist(pairLR[x,], use.names = F) %in% c(features.sig, rownames(complexSubunits.sig)))) { + Sys.sleep(1/nrun) + p(sprintf("(Step 3) %g of %g", x, nrun)) # Use with_progress() to see progress bar in client-side if (all(unlist(pairLR[x,], use.names = F) %in% c(gene.use, rownames(complexSubunits.use))) & (length(intersect(unlist(pairLR[x,], use.names = F), c(features.sig, rownames(complexSubunits.sig)))) > 0)) { return(x) }