Merge pull request #192 from zhanghao-njmu/develop

Develop

R/SCP-plot.R

@@ -2763,12 +2763,13 @@ FeatureDimPlot <- function(srt, features, reduction = NULL, dims = c(1, 2), spli
 #' Plotting cell points on a reduced 3D space and coloring according to the groups of the cells.
 #'
 #' @inheritParams CellDimPlot
+#' @param dims Dimensions to plot, must be a three-length numeric vector specifying x-, y- and z-dimensions
 #' @param axis_labs A character vector of length 3 indicating the labels for the axes.
 #' @param span A numeric value specifying the span of the loess smoother for lineages line.
 #' @param shape.highlight Shape of the cell to highlight. See \href{https://plotly.com/r/reference/scattergl/#scattergl-marker-symbol}{scattergl-marker-symbol}
 #' @param width Width in pixels, defaults to automatic sizing.
 #' @param height Height in pixels, defaults to automatic sizing.
-#' @param save The name of the file to save the plot to. Must end in .html.
+#' @param save The name of the file to save the plot to. Must end in ".html".
 #' @seealso \code{\link{CellDimPlot}} \code{\link{FeatureDimPlot3D}}
 #'
 #' @examples
@@ -2778,6 +2779,7 @@ FeatureDimPlot <- function(srt, features, reduction = NULL, dims = c(1, 2), spli
 #'
 #' pancreas_sub <- RunSlingshot(pancreas_sub, group.by = "SubCellType", reduction = "StandardpcaUMAP3D")
 #' CellDimPlot3D(pancreas_sub, group.by = "SubCellType", reduction = "StandardpcaUMAP3D", lineages = "Lineage1")
+#'
 #' @importFrom Seurat Reductions Embeddings Key
 #' @importFrom utils askYesNo
 #' @importFrom plotly plot_ly add_trace layout as_widget
@@ -2857,9 +2859,6 @@ CellDimPlot3D <- function(srt, group.by, reduction = NULL, dims = c(1, 2, 3), ax
     dat_lineages <- [email protected][, unique(lineages), drop = FALSE]
     dat_use <- cbind(dat_use, dat_lineages[row.names(dat_use), , drop = FALSE])
   }
-  if (!is.factor(dat_use[[group.by]])) {
-    dat_use[[group.by]] <- factor(dat_use[[group.by]], levels = unique(dat_use[[group.by]]))
-  }
   dat_use[["group.by"]] <- dat_use[[group.by]]
   if (any(is.na(dat_use[[group.by]]))) {
     n <- as.character(dat_use[[group.by]])

R/SCP-workflow.R

@@ -838,7 +838,8 @@ RunDimReduction <- function(srt, prefix = "", features = NULL, assay = NULL, slo
           srt@misc[["Default_reduction"]] <- paste0(prefix, linear_reduction)
           return(srt)
         } else {
-          message("assay.used is ", srt[[linear_reduction]]@assay.used, ", which is not the same as the ", assay, " specified. Recalculate the linear reduction")
+          message("assay.used is ", srt[[linear_reduction]]@assay.used, ", which is not the same as the ", assay, " specified. Recalculate the linear reduction(pca)")
+          linear_reduction <- "pca"
         }
       }
     }
@@ -933,7 +934,8 @@ RunDimReduction <- function(srt, prefix = "", features = NULL, assay = NULL, slo
           srt@misc[["Default_reduction"]] <- paste0(prefix, nonlinear_reduction)
           return(srt)
         } else {
-          message("assay.used is ", srt[[nonlinear_reduction]]@assay.used, ", which is not the same as the ", assay, " specified. Recalculate the linear reduction")
+          message("assay.used is ", srt[[nonlinear_reduction]]@assay.used, ", which is not the same as the ", assay, " specified. Recalculate the nonlinear reduction(umap)")
+          nonlinear_reduction <- "umap"
         }
       }
     }
@@ -1031,7 +1033,7 @@ DefaultReduction <- function(srt, pattern = NULL, min_dim = 2, max_distance = 0.
   if (length(srt@reductions) == 0) {
     stop("Unable to find any reductions.")
   }
-  pattern_default <- c("umap", "tsne", "dm", "phate", "pacmap", "trimap", "largevis", "pca", "svd", "ica", "nmf", "mds", "glmpca")
+  pattern_default <- c("umap", "tsne", "dm", "phate", "pacmap", "trimap", "largevis", "fr", "pca", "svd", "ica", "nmf", "mds", "glmpca")
   pattern_dim <- c("2D", "3D")
   reduc_all <- names(srt@reductions)
   reduc_all <- reduc_all[unlist(lapply(reduc_all, function(x) {
@@ -3204,25 +3206,25 @@ Conos_integrate <- function(srtMerge = NULL, batch = NULL, append = TRUE, srtLis
     }
     cat(paste0("[", Sys.time(), "]", " Perform linear dimension reduction (", linear_reduction, ") on the data ", i, " ...\n"))
     srt <- RunDimReduction(
-      srt = srt, prefix = "", features = HVF, assay = DefaultAssay(srt),
+      srt = srt, prefix = "Conos", features = HVF, assay = DefaultAssay(srt),
       linear_reduction = linear_reduction, linear_reduction_dims = linear_reduction_dims, linear_reduction_params = linear_reduction_params, force_linear_reduction = force_linear_reduction,
       verbose = FALSE, seed = seed
     )
-    srt[["pca"]] <- srt[[linear_reduction]]
+    srt[["pca"]] <- srt[[paste0("Conos", linear_reduction)]]
     srtList[[i]] <- srt
   }
   if (is.null(names(srtList))) {
     names(srtList) <- paste0("srt_", seq_along(srtList))
   }
 
   if (is.null(linear_reduction_dims_use)) {
-    maxdims <- max(unlist(sapply(srtList, function(srt) max(srt@reductions[[paste0("", linear_reduction)]]@misc[["dims_estimate"]]))))
+    maxdims <- max(unlist(sapply(srtList, function(srt) max(srt@reductions[[paste0("Conos", linear_reduction)]]@misc[["dims_estimate"]]))))
   } else {
     maxdims <- max(linear_reduction_dims_use)
   }
 
   cat(paste0("[", Sys.time(), "]", " Perform integration(Conos) on the data...\n"))
-  message("Conos using ", linear_reduction, "(dims_max:", maxdims, ") as input")
+  message("Conos integration using Reduction(", linear_reduction, ", dims_max:", maxdims, ") as input")
   srtList_con <- conos::Conos$new(srtList, n.cores = num_threads)
   params <- list(
     ncomps = maxdims,
@@ -3739,14 +3741,18 @@ Standard_SCP <- function(srt, prefix = "Standard", assay = NULL,
 #' for (method in integration_methods) {
 #'   panc8_sub <- Integration_SCP(
 #'     srtMerge = panc8_sub, batch = "tech",
-#'     integration_method = method, linear_reduction_dims_use = 1:50, nonlinear_reduction = "umap"
+#'     integration_method = method,
+#'     linear_reduction_dims_use = 1:50,
+#'     nonlinear_reduction = "umap"
 #'   )
 #'   print(CellDimPlot(panc8_sub, group.by = c("tech", "celltype"), reduction = paste0(method, "UMAP2D"), theme_use = "theme_blank"))
 #' }
 #'
 #' nonlinear_reductions <- c("umap", "tsne", "dm", "phate", "pacmap", "trimap", "largevis", "fr")
 #' panc8_sub <- Integration_SCP(
-#'   srtMerge = panc8_sub, batch = "tech", integration_method = "Seurat",
+#'   srtMerge = panc8_sub, batch = "tech",
+#'   integration_method = "Seurat",
+#'   linear_reduction_dims_use = 1:50,
 #'   nonlinear_reduction = nonlinear_reductions
 #' )
 #' for (nr in nonlinear_reductions) {

R/Seurat-function.R

@@ -117,7 +117,7 @@ RunNMF.default <- function(object, assay = NULL, slot = "data", nbes = 50,
   }
   nbes <- min(nbes, nrow(x = object) - 1)
   if (nmf.method == "RcppML") {
-    check_R("zdebruine/RcppML@0.5.6")
+    check_R("zdebruine/RcppML")
     options("RcppML.verbose" = FALSE)
     options("RcppML.threads" = 0)
     nmf.results <- RcppML::nmf(
@@ -1602,7 +1602,7 @@ RunLargeVis.Seurat <- function(object, reduction = "pca", dims = NULL, features
     search_k = search_k, n_threads = n_threads, n_sgd_threads = n_sgd_threads, grain_size = grain_size,
     kernel = kernel, pca = pca, pca_center = pca_center, pcg_rand = pcg_rand, fast_sgd = fast_sgd,
     batch = batch, opt_args = opt_args, epoch_callback = epoch_callback, pca_method = pca_method,
-    reduction.key = reduction.key, verbose = verbose, seed.use = seed.use, ...
+    reduction.key = reduction.key, verbose = verbose, seed.use = seed.use
   )
   object <- LogSeuratCommand(object = object)
   return(object)

R/utils.R

@@ -9,7 +9,6 @@
 #' If a conda environment with the specified name already exists and \code{force} is set to \code{FALSE}, the function will use the existing environment. If \code{force} set to \code{TRUE}, the existing environment will be recreated. Note that recreating the environment will remove any existing data in the environment.
 #' The function also checks if the package versions in the environment meet the requirements specified by the \code{version} parameter. The default is \code{3.8-1}.
 #'
-#'
 #' @export
 PrepareEnv <- function(conda = "auto", miniconda_repo = "https://repo.anaconda.com/miniconda",
                        envname = NULL, version = "3.8-1", force = FALSE, ...) {
@@ -142,8 +141,8 @@ PrepareEnv <- function(conda = "auto", miniconda_repo = "https://repo.anaconda.c
 #' Env_requirements("3.8-1")
 #'
 #' @export
-Env_requirements <- function(version = c("3.8-1", "3.8-2", "3.9-1", "3.10-1", "3.11-1")) {
-  version <- match.arg(version)
+Env_requirements <- function(version = "3.8-1") {
+  version <- match.arg(version, choices = c("3.8-1", "3.8-2", "3.9-1", "3.10-1", "3.11-1"))
   requirements <- switch(version,
     "3.8-1" = list(
       python = "3.8",
@@ -159,7 +158,10 @@ Env_requirements <- function(version = c("3.8-1", "3.8-2", "3.9-1", "3.10-1", "3
         "scikit-learn" = "scikit-learn==1.1.2",
         "scipy" = "scipy==1.10.1",
         "scvelo" = "scvelo==0.2.5",
-        "wot" = "wot==1.0.8.post2"
+        "wot" = "wot==1.0.8.post2",
+        "trimap" = "trimap==1.1.4",
+        "pacmap" = "pacmap==0.7.0",
+        "phate" = "phate==1.0.11"
         # "tables" = "git+https://github.com/PyTables/PyTables", # Fixed: PyTables install fails on macOS M1
       )
     ),
@@ -168,7 +170,7 @@ Env_requirements <- function(version = c("3.8-1", "3.8-2", "3.9-1", "3.10-1", "3
       packages = c(
         "leidenalg" = "leidenalg==0.10.1",
         "matplotlib" = "matplotlib==3.7.3",
-        "numba" = "numba==0.58.0",
+        "numba" = "numba==0.58.1",
         "numpy" = "numpy==1.24.4",
         "palantir" = "palantir==1.3.0",
         "pandas" = "pandas==1.5.3",
@@ -185,7 +187,7 @@ Env_requirements <- function(version = c("3.8-1", "3.8-2", "3.9-1", "3.10-1", "3
       packages = c(
         "leidenalg" = "leidenalg==0.10.1",
         "matplotlib" = "matplotlib==3.8.0",
-        "numba" = "numba==0.58.0",
+        "numba" = "numba==0.58.1",
         "numpy" = "numpy==1.25.2",
         "palantir" = "palantir==1.3.0",
         "pandas" = "pandas==1.5.3",
@@ -202,7 +204,7 @@ Env_requirements <- function(version = c("3.8-1", "3.8-2", "3.9-1", "3.10-1", "3
       packages = c(
         "leidenalg" = "leidenalg==0.10.1",
         "matplotlib" = "matplotlib==3.8.0",
-        "numba" = "numba==0.58.0",
+        "numba" = "numba==0.58.1",
         "numpy" = "numpy==1.25.2",
         "palantir" = "palantir==1.3.0",
         "pandas" = "pandas==1.5.3",
@@ -219,7 +221,7 @@ Env_requirements <- function(version = c("3.8-1", "3.8-2", "3.9-1", "3.10-1", "3
       packages = c(
         "leidenalg" = "leidenalg==0.10.1",
         "matplotlib" = "matplotlib==3.8.0",
-        "numba" = "numba==0.58.0",
+        "numba" = "numba==0.58.1",
         "numpy" = "numpy==1.25.2",
         "palantir" = "palantir==1.3.0",
         "pandas" = "pandas==1.5.3",
@@ -519,40 +521,19 @@ check_Python <- function(packages, envname = NULL, conda = "auto", force = FALSE
 
 #' Check and install R packages
 #'
-#' @param packages Package to be installed. Package source can be CRAN, Bioconductor or Github, e.g. scmap, davidsjoberg/ggsankey.
-#' @param package_names The name of the package that corresponds to the \code{packages} parameter, used to check if the package is already installed.
+#' @param packages Package to be installed. Package source can be CRAN, Bioconductor or Github, e.g. scmap, quadbiolab/simspec.
 #' By default, the package name is extracted according to the \code{packages} parameter.
 #' @param install_methods Functions used to install R packages.
 #' @param lib  The location of the library directories where to install the packages.
 #' @param force Whether to force the installation of packages. Default is \code{FALSE}.
 #'
 #' @importFrom utils packageVersion
 #' @export
-check_R <- function(packages, package_names = NULL, install_methods = c("BiocManager::install", "install.packages", "devtools::install_github"), lib = .libPaths()[1], force = FALSE) {
-  if (length(package_names) != 0 && length(package_names) != length(packages)) {
-    stop("package_names must be NULL or a vector of the same length with packages")
-  }
+check_R <- function(packages, install_methods = c("BiocManager::install", "install.packages", "devtools::install_github"), lib = .libPaths()[1], force = FALSE) {
   status_list <- list()
-  for (n in seq_along(packages)) {
-    pkg <- packages[n]
-    pkg_info <- pkg
-    if (!grepl("/", pkg_info)) {
-      pkg_info <- paste0("/", pkg_info)
-    }
-    if (!grepl("@", pkg_info)) {
-      pkg_info <- paste0(pkg_info, "@")
-    }
-    git <- grep("/", sub(pattern = "(.*/)(.*)(@.*)", replacement = "\\1", x = pkg_info), value = TRUE)
-    git <- gsub("/", "", git)
-    pkg_name <- package_names[n] %||% sub(pattern = "(.*/)(.*)(@.*)", replacement = "\\2", x = pkg_info)
-    version <- grep("@", sub(pattern = "(.*/)(.*)(@.*)", replacement = "\\3", x = pkg_info), value = TRUE)
-    version <- gsub("@", "", version)
-    if (version != "") {
-      force_update <- isTRUE(packageVersion(pkg_name) < package_version(version)) || isTRUE(force)
-    } else {
-      force_update <- isTRUE(force)
-    }
-    if (!suppressPackageStartupMessages(requireNamespace(pkg_name, quietly = TRUE)) || isTRUE(force_update)) {
+  for (pkg in packages) {
+    pkg_name <- sub(pattern = "(.*)/(.*)", replacement = "\\2", x = pkg)
+    if (!suppressPackageStartupMessages(requireNamespace(pkg_name, quietly = TRUE)) || isTRUE(force)) {
       message("Install package: \"", pkg_name, "\" ...")
       status_list[[pkg]] <- FALSE
       i <- 1
@@ -577,15 +558,7 @@ check_R <- function(packages, package_names = NULL, install_methods = c("BiocMan
         }, error = function(e) {
           status_list[[pkg]] <- FALSE
         })
-        if (version == "") {
-          status_list[[pkg]] <- requireNamespace(pkg_name, quietly = TRUE)
-        } else {
-          if (requireNamespace(pkg_name, quietly = TRUE)) {
-            status_list[[pkg]] <- packageVersion(pkg_name) >= package_version(version)
-          } else {
-            status_list[[pkg]] <- FALSE
-          }
-        }
+        status_list[[pkg]] <- requireNamespace(pkg_name, quietly = TRUE)
         i <- i + 1
         if (i > length(install_methods)) {
           break