Fix some bugs

zhanghao-njmu · Nov 2, 2023 · 7510a1b · 7510a1b
1 parent e743249
commit 7510a1b
Show file tree

Hide file tree

Showing 5 changed files with 36 additions and 12 deletions.
diff --git a/R/SCP-analysis.R b/R/SCP-analysis.R
@@ -2846,12 +2846,19 @@ PrepareDB <- function(species = c("Homo_sapiens", "Mus_musculus"),
           }
           message("Preparing database: TRRUST")
           url <- switch(db_species["TRRUST"],
-            "Homo_sapiens" = "https://www.grnpedia.org/trrust/data/trrust_rawdata.human.tsv",
-            "Mus_musculus" = "https://www.grnpedia.org/trrust/data/trrust_rawdata.mouse.tsv"
+            "Homo_sapiens" = "https://raw.githubusercontent.com/bioinfonerd/Transcription-Factor-Databases/master/Ttrust_v2/trrust_rawdata.human.tsv",
+            "Mus_musculus" = "https://raw.githubusercontent.com/bioinfonerd/Transcription-Factor-Databases/master/Ttrust_v2/trrust_rawdata.mouse.tsv.gz"
           )
-          temp <- tempfile()
-          download(url = url, destfile = temp)
-          TERM2GENE <- read.table(temp, header = FALSE, fill = T, sep = "\t")[, 1:2]
+          if (endsWith(url, "gz")) {
+            temp <- tempfile(fileext = ".gz")
+            download(url = url, destfile = temp)
+            R.utils::gunzip(temp)
+            TERM2GENE <- read.table(gsub(".gz$", "", temp), header = FALSE, fill = T, sep = "\t")[, 1:2]
+          } else {
+            temp <- tempfile()
+            download(url = url, destfile = temp)
+            TERM2GENE <- read.table(temp, header = FALSE, fill = T, sep = "\t")[, 1:2]
+          }
           version <- "v2.0"
           TERM2NAME <- TERM2GENE[, c(1, 1)]
           colnames(TERM2GENE) <- c("Term", default_IDtypes[["TRRUST"]])
@@ -3275,7 +3282,7 @@ PrepareDB <- function(species = c("Homo_sapiens", "Mus_musculus"),
       }
     }
 
-    ### Convert ID
+    ### Convert ID types
     for (term in names(db_list[[sps]])) {
       IDtypes <- db_IDtypes[!db_IDtypes %in% colnames(db_list[[sps]][[term]][["TERM2GENE"]])]
       if (length(IDtypes) > 0) {
@@ -4061,7 +4068,10 @@ RunMonocle2 <- function(srt, assay = NULL, slot = "counts", expressionFamily = "
                         root_state = NULL, seed = 11) {
   set.seed(seed)
   check_R(c("monocle", "DDRTree", "BiocGenerics", "Biobase", "VGAM"))
-  attachNamespace("DDRTree")
+
+  if (!"package:DDRTree" %in% search()) {
+    attachNamespace("DDRTree")
+  }
 
   assay <- assay %||% DefaultAssay(srt)
   expr_matrix <- as.sparse(GetAssayData(srt, assay = assay, slot = slot))

diff --git a/R/SCP-app.R b/R/SCP-app.R
@@ -591,7 +591,7 @@ RunSCExplorer <- function(base_dir = "SCExplorer",
                           style_script = require("styler", quietly = TRUE),
                           overwrite = FALSE,
                           return_app = TRUE) {
-  check_R(c("rhdf5", "HDF5Array", "shiny@1.6.0", "ggplot2", "ragg", "htmlwidgets", "plotly", "bslib", "future", "promises", "BiocParallel"))
+  check_R(c("rhdf5", "HDF5Array", "shiny", "ggplot2", "ragg", "htmlwidgets", "plotly", "bslib", "future", "promises", "BiocParallel"))
   DataFile_full <- paste0(base_dir, "/", DataFile)
   MetaFile_full <- paste0(base_dir, "/", MetaFile)
   if (!file.exists(DataFile_full) || !file.exists(MetaFile_full)) {

diff --git a/R/SCP-cellqc.R b/R/SCP-cellqc.R
@@ -344,7 +344,7 @@ RunCellQC <- function(srt, assay = "RNA", split.by = NULL,
   }
   status <- check_DataType(srt, slot = "counts", assay = assay)
   if (status != "raw_counts") {
-    stop("Data type is not raw counts!")
+    warning("Data type is not raw counts!")
   }
   if (!paste0("nCount_", assay) %in% colnames(srt@meta.data)) {
     srt@meta.data[[paste0("nCount_", assay)]] <- colSums(srt[[assay]]@counts)

diff --git a/R/Seurat-function.R b/R/Seurat-function.R
@@ -120,7 +120,9 @@ RunNMF.default <- function(object, assay = NULL, slot = "data", nbes = 50,
     check_R("zdebruine/RcppML")
     options("RcppML.verbose" = FALSE)
     options("RcppML.threads" = 0)
-    attachNamespace("Matrix")
+    if (!"package:Matrix" %in% search()) {
+      attachNamespace("Matrix")
+    }
     nmf.results <- RcppML::nmf(
       t(object),
       k = nbes, tol = tol, maxit = maxit,

diff --git a/R/utils.R b/R/utils.R
@@ -558,8 +558,20 @@ check_Python <- function(packages, envname = NULL, conda = "auto", force = FALSE
 check_R <- function(packages, install_methods = c("BiocManager::install", "install.packages", "devtools::install_github"), lib = .libPaths()[1], force = FALSE) {
   status_list <- list()
   for (pkg in packages) {
-    pkg_name <- sub(pattern = "(.*)/(.*)", replacement = "\\2", x = pkg)
-    if (!suppressPackageStartupMessages(requireNamespace(pkg_name, quietly = TRUE)) || isTRUE(force)) {
+    if (grepl("/", pkg)) {
+      # github package
+      pkg_name <- strsplit(pkg, split = "/|@|==", perl = TRUE)[[1]][[2]]
+      version <- NULL
+    } else {
+      pkg_name <- strsplit(pkg, split = "@|==", perl = TRUE)[[1]][[1]]
+      version <- strsplit(pkg, split = "@|==", perl = TRUE)[[1]][[2]]
+    }
+    if (is.null(version)) {
+      force_update <- isTRUE(force)
+    } else {
+      force_update <- isTRUE(packageVersion(pkg_name) < package_version(version)) || isTRUE(force)
+    }
+    if (!suppressPackageStartupMessages(requireNamespace(pkg_name, quietly = TRUE)) || isTRUE(force_update)) {
       message("Install package: \"", pkg_name, "\" ...")
       status_list[[pkg]] <- FALSE
       i <- 1