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

biopipen/scripts/regulatory/MotifAffinityTest.R

@@ -1,6 +1,6 @@
 # Script for regulatory.MotifAffinityTest
+{{ biopipen_dir | joinpaths: "utils", "misc.R" | source_r }}
 
-source("{{biopipen_dir}}/utils/misc.R")
 library(BiocParallel)
 library(BSgenome)
 library(universalmotif)
@@ -215,12 +215,8 @@ tool <- match.arg(tool, c("motifbreakr", "atsnp"))
 
 if (tool == "motifbreakr") {
     motifbreakr_args <- {{envs.motifbreakr_args | r}}
-    {% set sourcefile = biopipen_dir | joinpaths: "scripts", "regulatory", "MotifAffinityTest_MotifBreakR.R" %}
-    # {{ sourcefile | getmtime }}
-    source("{{sourcefile}}")
+    {{ biopipen_dir | joinpaths: "scripts", "regulatory", "MotifAffinityTest_MotifBreakR.R" | source_r }}
 } else {  # atsnp
     atsnp_args <- {{envs.atsnp_args | r}}
-    {% set sourcefile = biopipen_dir | joinpaths: "scripts", "regulatory", "MotifAffinityTest_AtSNP.R" %}
-    # {{ sourcefile | getmtime }}
-    source("{{sourcefile}}")
+    {{ biopipen_dir | joinpaths: "scripts", "regulatory", "MotifAffinityTest_AtSNP.R" | source_r }}
 }

biopipen/scripts/rnaseq/Simulation.R

@@ -1,4 +1,4 @@
-source("{{biopipen_dir}}/utils/misc.R")
+{{ biopipen_dir | joinpaths: "utils", "misc.R" | source_r }}
 
 ngenes <- {{in.ngenes | r}}
 nsamples <- {{in.nsamples | r}}

biopipen/scripts/rnaseq/UnitConversion.R

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

biopipen/scripts/scrna/AnnData2Seurat.R

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

biopipen/scripts/scrna/CellTypeAnnotation-celltypist.R

@@ -1,5 +1,3 @@
-source("{{biopipen_dir}}/utils/misc.R")
-
 library(rlang)
 library(hdf5r)
 library(dplyr)
@@ -8,6 +6,7 @@ library(Seurat)
 sobjfile <- {{in.sobjfile | r}}
 outfile <- {{out.outfile | r}}
 newcol <- {{envs.newcol | r}}
+merge_same_labels <- {{envs.merge | r}}
 celltypist_args <- {{envs.celltypist_args | r}}
 
 outdir <- dirname(outfile)
@@ -33,6 +32,7 @@ if (!file.exists(modelfile)) {
 sobj <- NULL
 outtype <- tolower(tools::file_ext(outfile))  # .rds, .h5ad, .h5seurat
 if (!endsWith(sobjfile, ".h5ad")) {
+    log_info("Convert input to H5AD ...")
     library(SeuratDisk)
 
     assay <- celltypist_args$assay
@@ -123,8 +123,7 @@ if (file.exists(celltypist_outfile) &&
     if (isTRUE(celltypist_args$majority_voting)) {
         command <- paste(command, "-v")
     }
-    print("Running celltypist:")
-    print(command)
+    log_info("Running celltypist:")
     log_debug("- {command}")
     rc <- system(command)
     if (rc != 0) {
@@ -135,11 +134,21 @@ if (file.exists(celltypist_outfile) &&
 if (outtype == "h5ad") {
     # log_info("Using H5AD from celltypist as output directly ...")
     # file.rename(paste0(out_prefix, ".h5ad"), outfile)
+    if (merge_same_labels) {
+        log_warn("- Merging clusters with the same labels is not supported for h5ad outfile ...")
+    }
 } else if (outtype == "h5seurat") {
     log_info("Converting H5AD from celltypist to H5Seurat ...")
     # outfile is cleaned by the pipeline anyway
     Convert(
-        celltypist_outfile, assay = assay %||% 'RNA', dest = outfile, overwrite = TRUE)
+        celltypist_outfile,
+        assay = assay %||% 'RNA',
+        dest = outfile,
+        overwrite = TRUE
+    )
+    if (merge_same_labels) {
+        log_warn("- Merging clusters with the same labels is not supported for h5seurat outfile ...")
+    }
 } else if (outtype == "rds") {
     if (is.null(sobj)) {
         log_info("Converting H5AD from celltypist to RDS ...")
@@ -178,7 +187,10 @@ if (outtype == "h5ad") {
         # end
 
         sobj <- LoadH5Seurat(h5seurat_file)
-        saveRDS(sobj, outfile)
+        if (merge_same_labels) {
+            log_info("Merging clusters with the same labels ...")
+            sobj <- merge_clusters_with_same_labels(sobj, newcol)
+        }
     } else {
         log_info("Attaching celltypist results to Seurat object ...")
 
@@ -228,9 +240,13 @@ if (outtype == "h5ad") {
         } else if (!is.null(newcol)) {
             sobj@meta.data[[newcol]] <- sobj@meta.data[["predicted_labels"]]
         }
-        log_info("Saving Seurat object in RDS ...")
-        saveRDS(sobj, outfile)
+        if (merge_same_labels) {
+            log_info("Merging clusters with the same labels ...")
+            sobj <- merge_clusters_with_same_labels(sobj, newcol)
+        }
     }
+    log_info("Saving Seurat object in RDS ...")
+    saveRDS(sobj, outfile)
 } else {
     stop(paste0("Unknown output type: ", outtype))
 }

biopipen/scripts/scrna/CellTypeAnnotation-common.R

@@ -0,0 +1,10 @@
+merge_clusters_with_same_labels <- function(sobj, newcol) {
+    if (is.null(newcol)) {
+        sobj@meta.data$seurat_clusters <- sub("\\.\\d+$", "", sobj@meta.data$seurat_clusters)
+        Idents(sobj) <- "seurat_clusters"
+    } else {
+        sobj@meta.data[[newcol]] <- sub("\\.\\d+$", "", sobj@meta.data[[newcol]])
+    }
+
+    sobj
+}

biopipen/scripts/scrna/CellTypeAnnotation-direct.R

@@ -1,14 +1,17 @@
-source("{{biopipen_dir}}/utils/misc.R")
 library(Seurat)
 
 sobjfile <- {{in.sobjfile | r}}
 outfile <- {{out.outfile | r}}
 celltypes <- {{envs.cell_types | r}}
 newcol <- {{envs.newcol | r}}
+merge_same_labels <- {{envs.merge | r}}
 
 if (is.null(celltypes) || length(celltypes) == 0) {
     log_warn("No cell types are given!")
 
+    if (merge_same_labels) {
+        log_warn("Ignoring 'envs.merge' because no cell types are given!")
+    }
     # create a symbolic link to the input file
     file.symlink(sobjfile, outfile)
 } else {
@@ -55,5 +58,10 @@ if (is.null(celltypes) || length(celltypes) == 0) {
         Idents(sobj) <- "seurat_clusters"
     }
 
+    if (merge_same_labels) {
+        log_info("Merging clusters with the same labels ...")
+        sobj <- merge_clusters_with_same_labels(sobj, newcol)
+    }
+
     saveRDS(sobj, outfile)
 }

biopipen/scripts/scrna/CellTypeAnnotation-hitype.R

@@ -2,21 +2,20 @@ library(Seurat)
 library(dplyr)
 library(hitype)
 
-source("{{biopipen_dir}}/utils/misc.R")
-
 sobjfile = {{in.sobjfile | r}}
 outfile = {{out.outfile | r}}
 tissue = {{envs.hitype_tissue | r}}
 db = {{envs.hitype_db | r}}
 newcol = {{envs.newcol | r}}
+merge_same_labels = {{envs.merge | r}}
 
 if (is.null(db)) { stop("`envs.hitype_db` is not set") }
 
-print("- Reading Seurat object...")
+log_info("Reading Seurat object...")
 sobj = readRDS(sobjfile)
 
 # prepare gene sets
-print("- Preparing gene sets...")
+log_info("Preparing gene sets...")
 if (startsWith(db, "hitypedb_") && !grepl(".", db, fixed = TRUE)) {
     gs_list = gs_prepare(eval(as.symbol(db)), tissue)
 } else {
@@ -24,10 +23,10 @@ if (startsWith(db, "hitypedb_") && !grepl(".", db, fixed = TRUE)) {
 }
 
 # run RunHitype
-print("- Running RunHitype...")
+log_info("Running RunHitype...")
 sobj = RunHitype(sobj, gs_list, threshold = 0.0, make_unique = TRUE)
 
-print("- Renaming cell types...")
+log_info("Renaming cell types...")
 hitype_levels = sobj@meta.data %>%
     select(seurat_clusters, hitype) %>%
     distinct(seurat_clusters, .keep_all = TRUE) %>%
@@ -42,10 +41,15 @@ if (is.null(newcol)) {
     sobj[[newcol]] = factor(sobj$hitype, levels = hitype_levels)
 }
 
-print("- Saving Seurat object...")
+if (merge_same_labels) {
+    log_info("Merging clusters with the same labels...")
+    sobj = merge_clusters_with_same_labels(sobj, newcol)
+}
+
+log_info("Saving Seurat object...")
 saveRDS(sobj, outfile)
 
-print("- Saving the mappings ...")
+log_info("Saving the mappings ...")
 if (is.null(newcol)) {
     celltypes = sobj@meta.data %>%
         group_by(seurat_clusters_id) %>%

biopipen/scripts/scrna/CellTypeAnnotation-sccatch.R

@@ -1,4 +1,3 @@
-source("{{biopipen_dir}}/utils/misc.R")
 library(scCATCH)
 library(Seurat)
 
@@ -6,6 +5,7 @@ sobjfile = {{in.sobjfile | r}}
 outfile = {{out.outfile | r}}
 sccatch_args = {{envs.sccatch_args | r}}
 newcol = {{envs.newcol | r}}
+merge_same_labels = {{envs.merge | r}}
 
 if (!is.null(sccatch_args$marker)) {
     cellmatch = readRDS(sccatch_args$marker)
@@ -17,14 +17,20 @@ if (is.integer(sccatch_args$use_method)) {
     sccatch_args$use_method = as.character(sccatch_args$use_method)
 }
 
+log_info("Reading Seurat object...")
 sobj = readRDS(sobjfile)
 
+log_info("Running createscCATCH ...")
 obj = createscCATCH(data = GetAssayData(sobj), cluster = as.character(Idents(sobj)))
 sccatch_args$object = obj
 
+log_info("Running findmarkergene ...")
 obj = do_call(findmarkergene, sccatch_args)
+
+log_info("Running findcelltype ...")
 obj = findcelltype(object = obj)
 
+log_info("Saving the mappings ...")
 write.table(
     obj@celltype,
     file = file.path(dirname(outfile), "cluster2celltype.tsv"),
@@ -36,7 +42,7 @@ celltypes = as.list(obj@celltype$cell_type)
 names(celltypes) = obj@celltype$cluster
 
 if (length(celltypes) == 0) {
-    warning("No cell types annotated from the database!")
+    log_warn("- No cell types annotated from the database!")
 } else {
     if (is.null(newcol)) {
         sobj$seurat_clusters_id = Idents(sobj)
@@ -49,5 +55,12 @@ if (length(celltypes) == 0) {
         sobj[[newcol]] = Idents(sobj)
         Idents(sobj) = "seurat_clusters"
     }
+
+    if (merge_same_labels) {
+        log_info("Merging clusters with the same labels ...")
+        sobj = merge_clusters_with_same_labels(sobj, newcol)
+    }
 }
+
+log_info("Saving Seurat object ...")
 saveRDS(sobj, outfile)

biopipen/scripts/scrna/CellTypeAnnotation-sctype.R

@@ -1,34 +1,37 @@
 library(dplyr)
 library(HGNChelper)
 library(Seurat)
+library(rlang)
 
-source("{{biopipen_dir}}/utils/misc.R")
-source("{{biopipen_dir}}/scripts/scrna/sctype.R")
+{{ biopipen_dir | joinpaths: "scripts", "scrna", "sctype.R" | source_r }}
 
 sobjfile = {{in.sobjfile | r}}
 outfile = {{out.outfile | r}}
 tissue = {{envs.sctype_tissue | r}}
 db = {{envs.sctype_db | r}}
 newcol = {{envs.newcol | r}}
+merge_same_labels = {{envs.merge | r}}
 
 if (is.null(db)) { stop("`envs.sctype_args.db` is not set") }
 
-print("- Reading Seurat object...")
+log_info("Reading Seurat object...")
 sobj = readRDS(sobjfile)
 
 # prepare gene sets
-print("- Preparing gene sets...")
+log_info("Preparing gene sets...")
 gs_list = gene_sets_prepare(db, tissue)
 
 scRNAseqData = GetAssayData(sobj, layer = "scale.data")
 idents = as.character(unique(Idents(sobj)))
 idents = idents[order(as.numeric(idents))]
 
+log_info("Working on different levels of cell type labels ...")
 cell_types_list = list()
 for (i in seq_along(gs_list)) {
+    log_info("- Working on level {i} ...")
     if (is.null(gs_list[[i]])) next
 
-    print(paste0("- Calculating cell-type scores for level ", i, "..."))
+    log_info("  Calculating cell-type scores ...")
     es.max = sctype_score(
         scRNAseqData = scRNAseqData,
         scaled = TRUE,
@@ -36,7 +39,7 @@ for (i in seq_along(gs_list)) {
         gs2 = gs_list[[i]]$gs_negative
     )
 
-    print(paste0("- Merging cell-type scores by cluster for level ", i, "..."))
+    log_info("  Merging cell-type scores by cluster ...")
     cl_resutls = do_call(
         "rbind",
         lapply(
@@ -59,12 +62,12 @@ for (i in seq_along(gs_list)) {
         write("\n####### sctype_scores_count ########", stderr())
         write(capture.output(sctype_scores_count), stderr())
         write("\n####################################", stderr())
-        warning("Scores tied in the above clusters.", immediate. = TRUE)
+        log_info("  Scores tied in the above clusters.", immediate. = TRUE)
     }
 
     if (length(gs_list) == 1 || i > 1) {
         # set low-confident (low ScType score) clusters to "unknown"
-        print("- Setting low-confident clusters to 'Unknown'...")
+        log_info("  Setting low-confident clusters to 'Unknown'...")
         sctype_scores$type[as.numeric(as.character(sctype_scores$scores)) < sctype_scores$ncells/4] = "Unknown"
     }
 
@@ -82,7 +85,7 @@ for (i in seq_along(gs_list)) {
 if (length(cell_types_list) == 1) {
     celltypes = cell_types_list[[1]]
 } else {
-    print("- Merging cell types at all levels ...")
+    log_info("Merging cell types at all levels ...")
     celltypes = list()
 
     for (i in idents) {
@@ -97,7 +100,18 @@ if (length(cell_types_list) == 1) {
 }
 
 
-print("- Renaming cell types...")
+log_info("Renaming cell types...")
+ct_numbering = list()
+for (key in names(celltypes)) {
+    ct = celltypes[[key]]
+    ct_numbering[[ct]] = ct_numbering[[ct]] %||% 0
+    if (ct_numbering[[ct]] > 0) {
+        celltypes[[key]] = paste0(ct, ".", ct_numbering[[ct]])
+    }
+    ct_numbering[[ct]] = ct_numbering[[ct]] + 1
+}
+
+celltypes = as.list(celltypes)
 if (is.null(newcol)) {
     sobj$seurat_clusters_id = sobj$seurat_clusters
     celltypes$object = sobj
@@ -109,12 +123,18 @@ if (is.null(newcol)) {
     sobj[[newcol]] = Idents(sobj)
     Idents(sobj) = "seurat_clusters"
 }
-
-print("- Saving Seurat object...")
-saveRDS(sobj, outfile)
-
-print("- Saving the mappings ...")
 celltypes$object = NULL
+gc()
+
+if (merge_same_labels) {
+    log_info("Merging clusters with the same labels...")
+    sobj <- merge_clusters_with_same_labels(sobj, newcol)
+    celltypes <- lapply(celltypes, function(ct) {
+        sub("\\.\\d+$", "", ct)
+    })
+}
+
+log_info("Saving the mappings ...")
 write.table(
     data.frame(
         Cluster = names(celltypes),
@@ -126,3 +146,6 @@ write.table(
     quote = FALSE,
     row.names = FALSE
 )
+
+log_info("Saving Seurat object...")
+saveRDS(sobj, outfile)

biopipen/scripts/scrna/CellTypeAnnotation.R

@@ -1,5 +1,8 @@
 set.seed(8525)
 
+{{ biopipen_dir | joinpaths: "utils", "misc.R" | source_r }}
+{{ biopipen_dir | joinpaths: "scripts", "scrna", "CellTypeAnnotation-common.R" | source_r }}
+
 {% if envs.tool == "hitype" %}
 {% include biopipen_dir + "/scripts/scrna/CellTypeAnnotation-hitype.R" %}
 {% elif envs.tool == "sctype" %}

biopipen/scripts/scrna/CellsDistribution.R

@@ -1,5 +1,6 @@
-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(Seurat)
 library(rlang)
 library(tidyr)

biopipen/scripts/scrna/DimPlots.R

@@ -1,7 +1,7 @@
 library(Seurat)
 library(dplyr)
 
-source("{{biopipen_dir}}/utils/misc.R")
+{{ biopipen_dir | joinpaths: "utils", "misc.R" | source_r }}
 
 srtfile = {{in.srtobj | r}}
 {% if in.configfile %}

biopipen/scripts/scrna/ExprImputation-alra.R

@@ -1,4 +1,4 @@
-source("{{biopipen_dir}}/utils/misc.R")
+{{ biopipen_dir | joinpaths: "utils", "misc.R" | source_r }}
 
 library(SeuratWrappers)
 library(Seurat)

biopipen/scripts/scrna/MarkersFinder.R

@@ -1,6 +1,6 @@
-source("{{biopipen_dir}}/utils/misc.R")
-source("{{biopipen_dir}}/utils/caching.R")
-source("{{biopipen_dir}}/utils/mutate_helpers.R")
+{{ biopipen_dir | joinpaths: "utils", "misc.R" | source_r }}
+{{ biopipen_dir | joinpaths: "utils", "caching.R" | source_r }}
+{{ biopipen_dir | joinpaths: "utils", "mutate_helpers.R" | source_r }}
 
 library(rlang)
 library(dplyr)
@@ -70,7 +70,8 @@ if (defassay == "SCT" && !"PrepSCTFindMarkers" %in% names(srtobj@commands)) {
 
     srtobj <- PrepSCTFindMarkers(srtobj)
     # compose a new SeuratCommand to record it to srtobj@commands
-    scommand <- srtobj@commands$FindClusters
+    commands <- names(pbmc_small@commands)
+    scommand <- pbmc_small@commands[[commands[length(commands)]]]
     scommand@name <- "PrepSCTFindMarkers"
     scommand@time.stamp <- Sys.time()
     scommand@assay.used <- "SCT"

biopipen/scripts/scrna/MetaMarkers.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(dplyr)
@@ -36,6 +36,20 @@ set.seed(8525)
 
 log_info("- Reading Seurat object ...")
 srtobj <- readRDS(srtfile)
+if (DefaultAssay(srtobj) == "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
+    commands <- names(pbmc_small@commands)
+    scommand <- pbmc_small@commands[[commands[length(commands)]]]
+    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
+}
 
 log_info("- Mutate meta data if needed ...")
 if (!is.null(mutaters) && length(mutaters)) {
@@ -79,13 +93,13 @@ expand_each <- function(name, case) {
             by = make.names(paste0("..", name, "_", case$each, "_", each))
             idents <- case$idents
             if (is.null(idents) || length(idents) == 0) {
-                srtobj@meta.data = srtobj@meta.data %>%
+                srtobj@meta.data <<- srtobj@meta.data %>%
                     mutate(
                         !!sym(by) := if_else(!!sym(case$each) == each, !!sym(case$group_by), NA)
                     )
                 idents <- srtobj@meta.data %>% pull(case$group_by) %>% unique() %>% na.omit()
             } else {
-                srtobj@meta.data = srtobj@meta.data %>%
+                srtobj@meta.data <<- srtobj@meta.data %>%
                     mutate(
                         !!sym(by) := if_else(
                             !!sym(case$each) == each & !!sym(case$group_by) %in% case$idents,
@@ -204,6 +218,10 @@ do_case <- function(casename) {
         if (is.null(df)) {
             msg <- "No markers found. May be due to too few cells or features."
         } else {
+            df <- df[
+                apply(df, 1, function(x) !all(is.na(x)) && !all(x == x[1])), ,
+                drop = FALSE
+            ]
             genes <- rownames(df)
             # rows: cells, cols: genes
             df <- cbind(as.data.frame(scale(Matrix::t(df))), sobj@meta.data[, case$group_by])

biopipen/scripts/scrna/ModuleScoreCalculator.R

@@ -1,4 +1,5 @@
-source("{{biopipen_dir}}/utils/misc.R")
+{{ biopipen_dir | joinpaths: "utils", "misc.R" | source_r }}
+
 library(Seurat)
 library(dplyr)
 

biopipen/scripts/scrna/RadarPlots.R

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

biopipen/scripts/scrna/ScFGSEA.R

@@ -1,6 +1,7 @@
-source("{{biopipen_dir}}/utils/misc.R")
-source("{{biopipen_dir}}/utils/gsea.R")
-source("{{biopipen_dir}}/utils/mutate_helpers.R")
+{{ biopipen_dir | joinpaths: "utils", "misc.R" | source_r }}
+{{ biopipen_dir | joinpaths: "utils", "gsea.R" | source_r }}
+{{ biopipen_dir | joinpaths: "utils", "mutate_helpers.R" | source_r }}
+
 library(rlang)
 library(Seurat)
 library(tidyseurat)

biopipen/scripts/scrna/Seurat2AnnData.R

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

biopipen/scripts/scrna/SeuratClusterStats-clustree.R

@@ -0,0 +1,73 @@
+# srtobj, clustrees_defaults, clustrees
+log_info("clustrees:")
+if (
+    (is.null(clustrees) || length(clustrees) == 0) &&
+    (is.null(clustrees_defaults$prefix) || clustrees_defaults$prefix == "")) {
+    log_warn("- no cases, skipping intentionally ...")
+} else {  # clustrees set or prefix is not empty
+    library(clustree)
+    odir = file.path(outdir, "clustrees")
+    dir.create(odir, recursive=TRUE, showWarnings=FALSE)
+
+    if ((is.null(clustrees) || length(clustrees) == 0) && clustrees_defaults$prefix == "_auto") {
+        clustrees <- list()
+        for (key in names(srtobj@commands)) {
+            if (startsWith(key, "FindClusters") && length(srtobj@commands[[key]]$resolution) > 1) {
+                pref <- substring(key, 14)
+                if (pref == "") {
+                    pref <- "seurat_clusters"
+                }
+
+                clustrees[[pref]] <- list(prefix = pref)
+            }
+        }
+    }
+    if (length(clustrees) == 0) {
+        log_warn("- no cases found, skipping ...")
+    } else {
+        reports <- list()
+        for (name in names(clustrees)) {
+            if (is.null(clustrees[[name]]$prefix)) {
+                stop(paste0("clustrees: prefix is required for case: ", name))
+            }
+            case <- list_update(clustrees_defaults, clustrees[[name]])
+
+            devpars <- case$devpars
+            devpars$width <- devpars$width %||% clustrees_defaults$devpars$width %||% 800
+            devpars$height <- devpars$height %||% clustrees_defaults$devpars$height %||% 1000
+            devpars$res <- devpars$res %||% clustrees_defaults$devpars$res %||% 100
+            case$devpars <- NULL
+            prefix <- sub("\\.$", "", case$prefix)
+            log_info("- Case: {name} ...")
+            case$prefix <- paste0(prefix, ".")
+            case$x <- srtobj@meta.data %>% select(starts_with(case$prefix))
+            case$x <- case$x[complete.cases(case$x), , drop = FALSE]
+
+            command <- srtobj@commands[[paste0("FindClusters.", prefix)]] %||%
+                (if(prefix == "seurat_clusters") srtobj@commands$FindClusters else NULL)
+
+            clustree_file <- file.path(odir, paste0(prefix, ".clustree.png"))
+            png(clustree_file, width = devpars$width, height = devpars$height, res = devpars$res)
+            p <- do_call(clustree, case)
+            print(p)
+            dev.off()
+
+            if (is.null(command)) {
+                resolution <- substring(colnames(case$x), nchar(case$prefix) + 1)
+            } else {
+                resolution <- command$resolution
+            }
+            resolution_used <- resolution[length(resolution)]
+
+            reports[[length(reports) + 1]] <- list(
+                kind = "table_image",
+                src = clustree_file,
+                name = name,
+                descr = paste0("Resolutions: ", paste(resolution, collapse = ", "), "; resolution used: ", resolution_used)
+            )
+        }
+        reports$h1 <- "Clustree plots"
+        reports$ui <- "table_of_images"
+        do.call(add_report, reports)
+    }
+}

biopipen/scripts/scrna/SeuratClusterStats-dimplots.R

@@ -1,13 +1,14 @@
 # Loaded variables: srtfile, outdir, srtobj
 
-dimplots_defaults = {{envs.dimplots_defaults | r: todot="-"}}
-dimplots = {{envs.dimplots | r: todot="-", skip=1}}
+# dimplots_defaults = {{envs.dimplots_defaults | r: todot="-"}}
+# dimplots = {{envs.dimplots | r: todot="-", skip=1}}
+log_info("dimplots:")
 
 odir = file.path(outdir, "dimplots")
 dir.create(odir, recursive=TRUE, showWarnings=FALSE)
 
 do_one_dimplot = function(name) {
-    log_info(paste0("Doing dimplots for: ", name))
+    log_info("- Case: {name}")
 
     case = list_update(dimplots_defaults, dimplots[[name]])
     case$devpars = list_update(dimplots_defaults$devpars, dimplots[[name]]$devpars)