biopipen 0.28.1__py3-none-any.whl → 0.29.1__py3-none-any.whl

biopipen/scripts/scrna/MarkersFinder.R

@@ -65,6 +65,19 @@ if (ncores > 1) {
 log_info("- Reading Seurat object ...")
 srtobj <- readRDS(srtfile)
 defassay <- DefaultAssay(srtobj)
+if (defassay == "SCT" && !"PrepSCTFindMarkers" %in% names(srtobj@commands)) {
+    log_warn("  SCTransform used but PrepSCTFindMarkers not applied, running ...")
+
+    srtobj <- PrepSCTFindMarkers(srtobj)
+    # compose a new SeuratCommand to record it to srtobj@commands
+    scommand <- srtobj@commands$FindClusters
+    scommand@name <- "PrepSCTFindMarkers"
+    scommand@time.stamp <- Sys.time()
+    scommand@assay.used <- "SCT"
+    scommand@call.string <- "PrepSCTFindMarkers(object = srtobj)"
+    scommand@params <- list()
+    srtobj@commands$PrepSCTFindMarkers <- scommand
+}
 
 if (!is.null(mutaters) && length(mutaters) > 0) {
     log_info("- Mutating meta data ...")
@@ -411,45 +424,11 @@ do_case_findall <- function(casename) {
         log_info("  Using cached markers ...")
         markers <- cached$data
     } else {
-        markers <- tryCatch({
-            do_call(FindAllMarkers, args)
-                # gene, p_val, avg_log2FC, pct.1, pct.2, p_val_adj, cluster
-            }, error = function(e) {
-                log_warn(e$message)
-
-                data.frame(
-                    gene = character(),
-                    p_val = numeric(),
-                    avg_log2FC = numeric(),
-                    pct.1 = numeric(),
-                    pct.2 = numeric(),
-                    p_val_adj=numeric(),
-                    cluster = character()
-                )
-            })
+        markers <- find_markers(args, find_all = TRUE)
         cached$data <- markers
         save_to_cache(cached, "FindAllMarkers", cache)
     }
 
-    if (nrow(markers) == 0 && defassay == "SCT") {
-        log_warn("  No markers found from SCT assay, try recorrect_umi = FALSE")
-        args$recorrect_umi <- FALSE
-        markers <- tryCatch({
-            do_call(FindAllMarkers, args)
-        }, error = function(e) {
-            log_warn(e$message)
-            data.frame(
-                gene = character(),
-                p_val = numeric(),
-                avg_log2FC = numeric(),
-                pct.1 = numeric(),
-                pct.2 = numeric(),
-                p_val_adj=numeric(),
-                cluster = character()
-            )
-        })
-    }
-
     if (is.null(case$dotplot$assay)) {
         case$dotplot$assay <- case$assay
     }
@@ -483,6 +462,60 @@ do_case_findall <- function(casename) {
     }
 }
 
+find_markers <- function(findmarkers_args, find_all = FALSE) {
+    if (find_all) {
+        fun <- FindAllMarkers
+        empty <- data.frame(
+            gene = character(),
+            p_val = numeric(),
+            avg_log2FC = numeric(),
+            pct.1 = numeric(),
+            pct.2 = numeric(),
+            p_val_adj = numeric(),
+            cluster = character()
+        )
+    } else {
+        fun <- FindMarkers
+        empty <- data.frame(
+            gene = character(),
+            p_val = numeric(),
+            avg_log2FC = numeric(),
+            pct.1 = numeric(),
+            pct.2 = numeric(),
+            p_val_adj = numeric()
+        )
+    }
+
+    call_findmarkers <- function(fn, args) {
+        if (find_all) {
+            do_call(fn, args)
+        } else {
+            do_call(fn, args) %>% rownames_to_column("gene")
+        }
+    }
+    markers <- tryCatch({
+        call_findmarkers(fun, findmarkers_args)
+    }, error = function(e) {
+        if (!grepl("PrepSCTFindMarkers", e$message) && defassay == "SCT") {
+            log_warn(paste0("  ! ", e$message))
+        }
+        empty
+    })
+
+    if (nrow(markers) == 0 && defassay == "SCT") {
+        log_warn("  ! No markers found from SCT assay, trying recorrect_umi = FALSE")
+        findmarkers_args$recorrect_umi <- FALSE
+        markers <- tryCatch({
+            call_findmarkers(fun, findmarkers_args)
+        }, error = function(e) {
+            log_warn(paste0("  ! ", e$message))
+            empty
+        })
+    }
+
+    markers
+}
+
 sections <- c()
 do_case <- function(casename) {
     if (isTRUE(cases[[casename]]$findall)) {
@@ -538,38 +571,7 @@ do_case <- function(casename) {
     # args$min.cells.feature <- args$min.cells.feature %||% 1
     # args$min.pct <- args$min.pct %||% 0
 
-    markers <- tryCatch({
-        do_call(FindMarkers, args) %>% rownames_to_column("gene")
-    }, error = function(e) {
-        log_warn(paste0("  ", e$message))
-        data.frame(
-            gene = character(),
-            p_val = numeric(),
-            avg_log2FC = numeric(),
-            pct.1 = numeric(),
-            pct.2 = numeric(),
-            p_val_adj = numeric()
-        )
-    })
-
-    if (nrow(markers) == 0 && defassay == "SCT") {
-        log_warn("  No markers found from SCT assay, trying recorrect_umi = FALSE")
-        args$recorrect_umi <- FALSE
-        markers <- tryCatch({
-            do_call(FindMarkers, args) %>% rownames_to_column("gene")
-        }, error = function(e) {
-            log_warn(paste0("  ", e$message))
-            data.frame(
-                gene = character(),
-                p_val = numeric(),
-                avg_log2FC = numeric(),
-                pct.1 = numeric(),
-                pct.2 = numeric(),
-                p_val_adj=numeric()
-            )
-        })
-    }
-
+    markers <- find_markers(args)
     siggenes <- do_enrich(info, markers, case$sigmarkers, case$volcano_genes)
 
     if (length(siggenes) > 0) {

biopipen/scripts/scrna/SeuratClustering.R

@@ -3,9 +3,11 @@ source("{{biopipen_dir}}/utils/caching.R")
 
 library(Seurat)
 library(future)
+library(rlang)
 library(tidyr)
 library(dplyr)
 library(digest)
+library(clustree)
 
 set.seed(8525)
 
@@ -129,45 +131,85 @@ if (is.null(cached$data)) {
 }
 
 envs$FindClusters$random.seed <- envs$FindClusters$random.seed %||% 8525
-resolution <- envs$FindClusters$resolution %||% 0.8
-if (is.character(resolution)) {
-    if (grepl(",", resolution)) {
-        resolution <- as.numeric(trimws(unlist(strsplit(resolution, ","))))
-    } else {
-        resolution <- as.numeric(resolution)
+expand_resolution <- function(resolution) {
+    expanded_res <- c()
+    for (res in resolution) {
+        if (is.numeric(res)) {
+            expanded_res <- c(expanded_res, res)
+        } else {
+            # is.character
+            parts <- trimws(unlist(strsplit(res, ",")))
+            for (part in parts) {
+                if (grepl(":", part)) {
+                    parts <- trimws(unlist(strsplit(part, ":")))
+                    if (length(parts) == 2) { parts <- c(parts, 0.1) }
+                    if (length(parts) != 3) {
+                        stop("Invalid resolution format: {part}. Expected 2 or 3 parts separated by ':' for a range.")
+                    }
+                    parts <- as.numeric(parts)
+                    expanded_res <- c(expanded_res, seq(parts[1], parts[2], by = parts[3]))
+                } else {
+                    expanded_res <- c(expanded_res, as.numeric(part))
+                }
+            }
+        }
     }
+    # keep the last resolution at last
+    rev(unique(rev(expanded_res)))
 }
+resolution <- envs$FindClusters$resolution <- expand_resolution(envs$FindClusters$resolution %||% 0.8)
+log_info("Running FindClusters at resolution: {paste(resolution, collapse=',')} ...")
+
+envs$FindClusters$object <- sobj
+sobj <- do_call(FindClusters, envs$FindClusters)
 
+# recode clusters from 0, 1, 2, ... to c1, c2, c3, ...
+recode_clusters <- function(clusters) {
+    recode <- function(x) paste0("c", as.integer(as.character(x)) + 1)
+    clusters <- factor(recode(clusters), levels = recode(levels(clusters)))
+    clusters
+}
+
+graph_name <- envs$FindClusters$graph.name %||% paste0(DefaultAssay(sobj), "_snn_res.")
 for (res in resolution) {
-    envs$FindClusters$resolution <- res
-    cached <- get_cached(envs$FindClusters, paste0("FindClusters_", res), cache_dir)
-    res_key <- paste0("seurat_clusters_", res)
-    if (is.null(cached$data)) {
-        log_info("Running FindClusters at resolution: {res} ...")
-        envs$FindClusters$object <- sobj
-        sobj <- do_call(FindClusters, envs$FindClusters)
-        levels(sobj$seurat_clusters) <- paste0("c", as.numeric(levels(sobj$seurat_clusters)) + 1)
-        sobj[[res_key]] <- sobj$seurat_clusters
-        Idents(sobj) <- "seurat_clusters"
-        cached$data <- list(clusters = sobj$seurat_clusters, commands = sobj@commands)
-        save_to_cache(cached, paste0("FindClusters_", res), cache_dir)
-    } else {
-        log_info("Loading cached FindClusters at resolution: {res} ...")
-        sobj@commands <- cached$data$commands
-        sobj[[res_key]] <- cached$data$clusters
-        sobj$seurat_clusters <- cached$data$clusters
-        Idents(sobj) <- "seurat_clusters"
-    }
-    ident_table <- table(Idents(sobj))
-    log_info("- Found {length(ident_table)} clusters")
-    print(ident_table)
-    cat("\n")
+    cluster_name <- paste0(graph_name, res)
+    new_cluster_name <- paste0("seurat_clusters.", res)
+    sobj@meta.data[[new_cluster_name]] <- recode_clusters(sobj@meta.data[[cluster_name]])
+}
+sobj@meta.data$seurat_clusters <- recode_clusters(sobj@meta.data$seurat_clusters)
+Idents(sobj) <- "seurat_clusters"
+
+ident_table <- table(Idents(sobj))
+log_info("- Found {length(ident_table)} clusters at resolution {resolution[length(resolution)]}")
+print(ident_table)
+cat("\n")
+
+# plot the tree
+if (length(resolution) > 1) {
+    log_info("Plotting clustree ...")
+    png(
+        file.path(joboutdir, "clustree.png"),
+        res = envs$clustree_devpars$res,
+        width = envs$clustree_devpars$width,
+        height = envs$clustree_devpars$height
+    )
+    p <- clustree(sobj, prefix = "seurat_clusters.")
+    print(p)
+    dev.off()
 }
 
 if (DefaultAssay(sobj) == "SCT") {
         # https://github.com/satijalab/seurat/issues/6968
     log_info("Running PrepSCTFindMarkers ...")
     sobj <- PrepSCTFindMarkers(sobj)
+    # compose a new SeuratCommand to record it to sobj@commands
+    scommand <- sobj@commands$FindClusters
+    scommand@name <- "PrepSCTFindMarkers"
+    scommand@time.stamp <- Sys.time()
+    scommand@assay.used <- "SCT"
+    scommand@call.string <- "PrepSCTFindMarkers(object = sobj)"
+    scommand@params <- list()
+    sobj@commands$PrepSCTFindMarkers <- scommand
 }
 
 log_info("Saving results ...")

biopipen/scripts/scrna/SeuratMap2Ref.R

@@ -63,6 +63,26 @@ if (endsWith(ref, ".rds") || endsWith(ref, ".RDS")) {
     reference = LoadH5Seurat(ref)
 }
 
+# check if refdata exists in the reference
+for (rname in names(mapquery_args$refdata)) {
+    use_name <- mapquery_args$refdata[[rname]]
+    # transferring an assay
+    if (use_name %in% names(reference)) { next }
+    # transferring a metadata column
+    if (!use_name %in% colnames(reference@meta.data)) {
+        stop(paste0(
+            "The reference does not have the column '",
+            use_name,
+            "' in either assays or metadata. "
+        ))
+        if (startsWith(use_name, "predicted.")) {
+            stop(paste0(
+                "Do you mean: ", substring(use_name, 11),
+            ))
+        }
+    }
+}
+
 if (refnorm == "auto" && DefaultAssay(reference) == "SCT") {
     refnorm = "SCTransform"
 }