biopipen 0.29.2__py3-none-any.whl → 0.31.0__py3-none-any.whl

biopipen/scripts/scrna/SeuratClustering.R

@@ -1,5 +1,5 @@
-source("{{biopipen_dir}}/utils/misc.R")
-source("{{biopipen_dir}}/utils/caching.R")
+{{ biopipen_dir | joinpaths: "utils", "misc.R" | source_r }}
+{{ biopipen_dir | joinpaths: "utils", "caching.R" | source_r }}
 
 library(Seurat)
 library(future)
@@ -7,7 +7,6 @@ library(rlang)
 library(tidyr)
 library(dplyr)
 library(digest)
-library(clustree)
 
 set.seed(8525)
 
@@ -24,16 +23,10 @@ options(str = strOptions(vec.len = 5, digits.d = 5))
 options(future.globals.maxSize = 80000 * 1024^2)
 plan(strategy = "multicore", workers = envs$ncores)
 
-.expand_dims <- function(args, name = "dims") {
-    # Expand dims from 30 to 1:30
-    if (is.numeric(args[[name]]) && length(args[[name]] == 1)) {
-        args[[name]] <- 1:args[[name]]
-    }
-    args
-}
+{{ biopipen_dir | joinpaths: "scripts", "scrna", "SeuratClustering-common.R" | source_r }}
 
-envs$RunUMAP <- .expand_dims(envs$RunUMAP)
-envs$FindNeighbors <- .expand_dims(envs$FindNeighbors)
+envs$RunUMAP <- expand_dims(envs$RunUMAP)
+envs$FindNeighbors <- expand_dims(envs$FindNeighbors)
 
 log_info("Reading Seurat object ...")
 sobj <- readRDS(srtfile)
@@ -53,164 +46,11 @@ if (is.character(envs$cache)) {
     writeLines(sobj_sig, file.path(cache_dir, "signature.txt"))
 }
 
-if (length(envs$ScaleData) > 0) {
-    if (DefaultAssay(sobj) == "SCT") {
-        stop("SCT assay detected, but ScaleData is specified. Use SCTransform instead.")
-    }
-    cached <- get_cached(envs$ScaleData, "ScaleData", cache_dir)
-    if (is.null(cached$data)) {
-        log_info("Running ScaleData ...")
-        envs$ScaleData$object <- sobj
-        sobj <- do_call(ScaleData, envs$ScaleData)
-        cached$data <- list(assay = sobj@assays$RNA, commands = sobj@commands)
-        save_to_cache(cached, "ScaleData", cache_dir)
-    } else {
-        log_info("Loading cached ScaleData ...")
-        sobj@assays$RNA <- cached$data$assay
-        sobj@commands <- cached$data$commands
-        DefaultAssay(sobj) <- "RNA"
-    }
-} else if (length(envs$SCTransform) > 0) {
-    if (DefaultAssay(sobj) != "SCT") {
-        stop("SCT assay not detected, but SCTransform is specified. Use ScaleData instead.")
-    }
-    cached <- get_cached(envs$SCTransform, "SCTransform", cache_dir)
-    asssay <- envs$SCTransform$new.assay.name %||% "SCT"
-    if (is.null(cached$data)) {
-        log_info("Running SCTransform ...")
-        envs$SCTransform$object <- sobj
-        sobj <- do_call(SCTransform, envs$SCTransform)
-        cached$data <- list(assay = sobj@assays$SCT, commands = sobj@commands)
-        save_to_cache(cached, "SCTransform", cache_dir)
-    } else {
-        log_info("Loading cached SCTransform ...")
-        sobj@assays[[assay]] <- cached$data$assay
-        sobj@commands <- cached$data$commands
-        DefaultAssay(sobj) <- assay
-    }
-}
-
-cached <- get_cached(envs$RunUMAP, "RunUMAP", cache_dir)
-reduc_name <- envs$RunUMAP$reduction.name %||% "umap"
-if (is.null(cached$data)) {
-    log_info("Running RunUMAP ...")
-    umap_args <- list_setdefault(
-        envs$RunUMAP,
-        object = sobj,
-        dims = 1:30,
-        reduction = sobj@misc$integrated_new_reduction %||% "pca"
-    )
-    ncells <- ncol(sobj)
-    umap_args$dims <- 1:min(max(umap_args$dims), ncells - 1)
-    umap_method <- envs$RunUMAP$umap.method %||% "uwot"
-    if (umap_method == "uwot" && is.null(envs$RunUMAP$n.neighbors)) {
-        # https://github.com/satijalab/seurat/issues/4312
-        umap_args$n.neighbors <- min(ncells - 1, 30)
-    }
-    sobj <- do_call(RunUMAP, umap_args)
-    cached$data <- list(reduc = sobj@reductions[[reduc_name]], commands = sobj@commands)
-    save_to_cache(cached, "RunUMAP", cache_dir)
-} else {
-    log_info("Loading cached RunUMAP ...")
-    sobj@reductions[[reduc_name]] <- cached$data$reduc
-    sobj@commands <- cached$data$commands
-}
-
-cached <- get_cached(envs$FindNeighbors, "FindNeighbors", cache_dir)
-if (is.null(cached$data)) {
-    log_info("Running FindNeighbors ...")
-    envs$FindNeighbors$object <- sobj
-    envs$FindNeighbors$reduction <- sobj@misc$integrated_new_reduction %||% "pca"
-    sobj <- do_call(FindNeighbors, envs$FindNeighbors)
-    cached$data <- list(graphs = sobj@graphs, commands = sobj@commands)
-    save_to_cache(cached, "FindNeighbors", cache_dir)
-} else {
-    log_info("Loading cached FindNeighbors ...")
-    sobj@graphs <- cached$data$graphs
-    sobj@commands <- cached$data$commands
-}
-
-envs$FindClusters$random.seed <- envs$FindClusters$random.seed %||% 8525
-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) {
-    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
-}
+sobj <- run_transformation(sobj)
+sobj <- run_umap(sobj)
+sobj <- run_findneighbors(sobj)
+sobj <- run_findclusters(sobj)
+sobj <- run_prepsctfindmarkers(sobj)
 
 log_info("Saving results ...")
 saveRDS(sobj, file = rdsfile)

biopipen/scripts/scrna/SeuratMap2Ref.R

@@ -1,4 +1,4 @@
-source("{{biopipen_dir}}/utils/misc.R")
+{{ biopipen_dir | joinpaths: "utils", "misc.R" | source_r }}
 
 library(parallel)
 library(Seurat)
@@ -17,6 +17,7 @@ refnorm = {{envs.refnorm | r}}
 ncores = {{envs.ncores | r}}
 split_by = {{envs.split_by | r}}
 mutaters = {{envs.mutaters | r}}
+skip_if_normalized = {{envs.skip_if_normalized | r}}
 sctransform_args = {{envs.SCTransform | r: todot="-"}}
 normalizedata_args = {{envs.NormalizeData | r: todot="-"}}
 findtransferanchors_args = {{envs.FindTransferAnchors | r: todot="-"}}
@@ -40,7 +41,7 @@ mapquery_args$refdata[[use]] = use
 
 outdir = dirname(outfile)
 if (is.null(split_by)) {
-    options(future.globals.maxSize = 80000 * 1024^2)
+    options(future.globals.maxSize = 8 * 1024 ^ 4)
     future::plan(strategy = "multicore", workers = ncores)
 }
 
@@ -98,6 +99,7 @@ if (refnorm == "SCTransform") {
 # Load Seurat object
 log_info("- Loading Seurat object")
 sobj = readRDS(sobjfile)
+defassay <- DefaultAssay(sobj)
 
 if (!is.null(mutaters) && length(mutaters) > 0) {
     log_info("- Applying mutaters")
@@ -126,41 +128,55 @@ if (!is.null(split_by)) {
 # Normalize data
 log_info("- Normalizing data")
 if (refnorm == "SCTransform") {
-    log_info("  Using SCTransform normalization")
-    sctransform_args$residual.features = rownames(x = reference)
-    if (is.null(split_by)) {
-        sctransform_args$object = sobj
-        query = do_call(SCTransform, sctransform_args)
+    if (defassay == "SCT" && skip_if_normalized) {
+        log_warn("  Skipping normalization as the object is already SCTransform'ed")
     } else {
-        query = mclapply(
-            X = sobj,
-            FUN = function(x) {
-                sctransform_args$object = x
-                do_call(SCTransform, sctransform_args)
-            },
-            mc.cores = ncores
-        )
-        if (any(unlist(lapply(query, class)) == "try-error")) {
-            stop(paste0("\nmclapply (SCTransform) error:", query))
+        log_info("  Using SCTransform normalization")
+        sctransform_args$residual.features = rownames(x = reference)
+        if (is.null(split_by)) {
+            sctransform_args$object = sobj
+            sobj = do_call(SCTransform, sctransform_args)
+            sctransform_args$object <- NULL
+            rm(sctransform_args)
+            gc()
+        } else {
+            sobj = mclapply(
+                X = sobj,
+                FUN = function(x) {
+                    sctransform_args$object = x
+                    do_call(SCTransform, sctransform_args)
+                },
+                mc.cores = ncores
+            )
+            if (any(unlist(lapply(sobj, class)) == "try-error")) {
+                stop(paste0("\nmclapply (SCTransform) error:", sobj))
+            }
         }
     }
 } else {
-    log_info("  Using NormalizeData normalization")
-    if (is.null(split_by)) {
-        normalizedata_args$object = sobj
-        query = do_call(NormalizeData, normalizedata_args)
+    if (defassay == "RNA" && skip_if_normalized) {
+        log_warn("  Skipping normalization as the object is already LogNormalize'd")
     } else {
-        query = mclapply(
-            X = sobj,
-            FUN = function(x) {
-                normalizedata_args$object = x
-                do_call(NormalizeData, normalizedata_args)
-            },
-            mc.cores = ncores
-        )
-        if (any(unlist(lapply(query, class)) == "try-error")) {
-            stop(paste0("\nmclapply (NormalizeData) error:", query))
+        log_info("  Using NormalizeData normalization")
+        if (is.null(split_by)) {
+            normalizedata_args$object = sobj
+            sobj = do_call(NormalizeData, normalizedata_args)
+        } else {
+            sobj = mclapply(
+                X = sobj,
+                FUN = function(x) {
+                    normalizedata_args$object = x
+                    do_call(NormalizeData, normalizedata_args)
+                },
+                mc.cores = ncores
+            )
+            if (any(unlist(lapply(sobj, class)) == "try-error")) {
+                stop(paste0("\nmclapply (NormalizeData) error:", sobj))
+            }
         }
+        normalizedata_args$object <- NULL
+        rm(normalizedata_args)
+        gc()
     }
 }
 
@@ -168,11 +184,15 @@ if (refnorm == "SCTransform") {
 log_info("- Finding anchors")
 findtransferanchors_args$reference = reference
 if (is.null(split_by)) {
-    findtransferanchors_args$query = query
+    findtransferanchors_args$query = sobj
     anchors = do_call(FindTransferAnchors, findtransferanchors_args)
+    findtransferanchors_args$reference = NULL
+    findtransferanchors_args$query = NULL
+    rm(findtransferanchors_args)
+    gc()
 } else {
     anchors = mclapply(
-        X = query,
+        X = sobj,
         FUN = function(x) {
             findtransferanchors_args$query = x
             do_call(FindTransferAnchors, findtransferanchors_args)
@@ -188,21 +208,25 @@ if (is.null(split_by)) {
 log_info("- Mapping query to reference")
 mapquery_args$reference = reference
 if (is.null(split_by)) {
-    mapquery_args$query = query
+    mapquery_args$query = sobj
     mapquery_args$anchorset = anchors
-    query = do_call(MapQuery, mapquery_args)
+    sobj = do_call(MapQuery, mapquery_args)
+    mapquery_args$reference = NULL
+    mapquery_args$query = NULL
+    mapquery_args$anchorset = NULL
+    gc()
 } else {
-    query = mclapply(
-        X = seq_along(query),
+    sobj = mclapply(
+        X = seq_along(sobj),
         FUN = function(i) {
-            mapquery_args$query = query[[i]]
+            mapquery_args$query = sobj[[i]]
             mapquery_args$anchorset = anchors[[i]]
             do_call(MapQuery, mapquery_args)
         },
         mc.cores = ncores
     )
-    if (any(unlist(lapply(query, class)) == "try-error")) {
-        stop(paste0("\nmclapply (MapQuery) error:", query))
+    if (any(unlist(lapply(sobj, class)) == "try-error")) {
+        stop(paste0("\nmclapply (MapQuery) error:", sobj))
     }
 }
 
@@ -221,9 +245,12 @@ if (is.null(split_by)) {
         if (e$message == "subscript out of bounds") stop(mappingscore_sob_msg)
         stop(e)
     })
+    mappingscore_args$anchors = NULL
+    rm(mappingscore_args)
+    gc()
 } else {
     mappingscore = mclapply(
-        X = seq_along(query),
+        X = seq_along(sobj),
         FUN = function(i) {
             mappingscore_args$anchors = anchors[[i]]
             tryCatch({
@@ -243,42 +270,59 @@ if (is.null(split_by)) {
 # Calculate mapping score and add to metadata
 log_info("- Adding mapping score to metadata")
 if (is.null(split_by)) {
-    query = AddMetaData(
-        object = query,
+    sobj = AddMetaData(
+        object = sobj,
         metadata = mappingscore,
         col.name = "mapping.score"
     )
 } else {
-    query = mclapply(
-        X = seq_along(query),
+    sobj = mclapply(
+        X = seq_along(sobj),
         FUN = function(i) {
             AddMetaData(
-                object = query[[i]],
+                object = sobj[[i]],
                 metadata = mappingscore[[i]],
                 col.name = "mapping.score"
             )
         },
         mc.cores = ncores
     )
-    if (any(unlist(lapply(query, class)) == "try-error")) {
-        stop(paste0("\nmclapply (AddMetaData) error:", query))
+    if (any(unlist(lapply(sobj, class)) == "try-error")) {
+        stop(paste0("\nmclapply (AddMetaData) error:", sobj))
     }
 
     # Combine the results
     log_info("- Merging the results")
-    query = merge(query[[1]], query[2:length(query)], merge.dr = "ref.umap")
+    gc()
+    # Memory efficient way to merge the results
+    # query = Reduce(function(x, y) merge(x, y, merge.dr = "ref.umap"), query)
+    sobj = merge(sobj[[1]], sobj[2:length(sobj)], merge.dr = "ref.umap")
 }
 
 # Add the alias to the metadata for the clusters
 log_info("- Adding ident to metadata and set as ident")
-query@meta.data = query@meta.data %>% mutate(
+sobj@meta.data = sobj@meta.data %>% mutate(
     !!sym(ident) := as.factor(!!parse_expr(paste0("predicted.", use)))
 )
-Idents(query) = ident
+Idents(sobj) = ident
+
+# Check if PrepSCTFindMarkers is done
+if (DefaultAssay(sobj) == "SCT") {
+    log_info("- Running PrepSCTFindMarkers ...")
+    sobj <- PrepSCTFindMarkers(sobj)
+    # compose a new SeuratCommand to record it to sobj@commands
+    commands <- names(pbmc_small@commands)
+    scommand <- pbmc_small@commands[[commands[length(commands)]]]
+    scommand@time.stamp <- Sys.time()
+    scommand@assay.used <- "SCT"
+    scommand@call.string <- "PrepSCTFindMarkers(object = sobj)"
+    scommand@params <- list()
+    sobj@commands$PrepSCTFindMarkers <- scommand
+}
 
 # Save
 log_info("- Saving result ...")
-saveRDS(query, file = outfile)
+saveRDS(sobj, file = outfile)
 
 
 # ############################
@@ -291,7 +335,7 @@ ref.reduction = mapquery_args$reduction.model %||% "wnn.umap"
 for (qname in names(mapquery_args$refdata)) {
     rname <- mapquery_args$refdata[[qname]]
 
-    if (grepl("Array", class(reference[[rname]])) && grepl("Array", class(query[[qname]]))) {
+    if (grepl("Array", class(reference[[rname]])) && grepl("Array", class(sobj[[qname]]))) {
         log_warn("  Skipping transferred array: {qname} -> {rname}")
         next
     }
@@ -308,7 +352,7 @@ for (qname in names(mapquery_args$refdata)) {
     ) + NoLegend()
 
     query_p <- DimPlot(
-        object = query,
+        object = sobj,
         reduction = "ref.umap",
         group.by = paste0("predicted.", qname),
         label = TRUE,

biopipen/scripts/scrna/SeuratMetadataMutater.R

@@ -1,5 +1,5 @@
-source("{{biopipen_dir}}/utils/misc.R")
-source("{{biopipen_dir}}/utils/mutate_helpers.R")
+{{ biopipen_dir | joinpaths: "utils", "misc.R" | source_r }}
+{{ biopipen_dir | joinpaths: "utils", "mutate_helpers.R" | source_r }}
 
 library(rlang)
 library(tibble)