biopipen 0.34.7__tar.gz → 0.34.9__tar.gz

{biopipen-0.34.7 → biopipen-0.34.9}/PKG-INFO

@@ -1,6 +1,6 @@
-Metadata-Version: 2.3
+Metadata-Version: 2.4
 Name: biopipen
-Version: 0.34.7
+Version: 0.34.9
 Summary: Bioinformatics processes/pipelines that can be run from `pipen run`
 License: MIT
 Author: pwwang
@@ -13,6 +13,7 @@ Classifier: Programming Language :: Python :: 3.10
 Classifier: Programming Language :: Python :: 3.11
 Classifier: Programming Language :: Python :: 3.12
 Classifier: Programming Language :: Python :: 3.13
+Classifier: Programming Language :: Python :: 3.14
 Provides-Extra: runinfo
 Requires-Dist: datar[pandas] (>=0.15.8,<0.16.0)
 Requires-Dist: pipen-board[report] (>=0.17,<0.18)

biopipen-0.34.9/biopipen/__init__.py

@@ -0,0 +1 @@
+__version__ = "0.34.9"

{biopipen-0.34.7 → biopipen-0.34.9}/biopipen/ns/regulatory.py

@@ -132,6 +132,9 @@ class MotifAffinityTest(Proc):
             If no `regulator_col` is provided, no regulator information is written in
             the output. Otherwise, the regulator information is written in the output in
             the `Regulator` column.
+        var_col: The column names in the `in.motiffile` containing the variant information.
+            It has to be matching the names in the `in.varfile`. This is helpful when
+            we only need to test the pairs of variants and motifs in the `in.motiffile`.
         notfound (choice): What to do if a motif is not found in the database,
             or a regulator is not found in the regulator-motif mapping (envs.regmotifs)
             file.
@@ -200,6 +203,7 @@ class MotifAffinityTest(Proc):
         "bcftools": config.exe.bcftools,
         "motif_col": None,
         "regulator_col": None,
+        "var_col": None,
         "notfound": "error",
         "motifdb": config.ref.tf_motifdb,
         "regmotifs": config.ref.tf_motifs,

{biopipen-0.34.7 → biopipen-0.34.9}/biopipen/ns/scrna.py

@@ -787,6 +787,11 @@ class ModuleScoreCalculator(Proc):
             `reduction = "DC"` in `env.dimplots` in `SeuratClusterStats`.
             This requires [`SingleCellExperiment`](https://bioconductor.org/packages/release/bioc/html/SingleCellExperiment.html)
             and [`destiny`](https://bioconductor.org/packages/release/bioc/html/destiny.html) R packages.
+        post_mutaters (type=json): The mutaters to mutate the metadata after
+            calculating the module scores.
+            The mutaters will be applied in the order specified.
+            This is useful when you want to create new scores based on the
+            calculated module scores.
     """  # noqa: E501
 
     input = "srtobj:file"
@@ -810,6 +815,7 @@ class ModuleScoreCalculator(Proc):
             # "Activation": {"features": "IFNG"},
             # "Proliferation": {"features": "STMN1,TUBB"},
         },
+        "post_mutaters": {},
     }
     script = "file://../scripts/scrna/ModuleScoreCalculator.R"
 
@@ -1131,7 +1137,7 @@ class MarkersFinder(Proc):
                 - res (type=int): The resolution of the plots.
                 - height (type=int): The height of the plots.
                 - width (type=int): The width of the plots.
-            - <more>: See <https://pwwang.github.io/scplotter/reference/EnrichmentPlot.htmll>.
+            - <more>: See <https://pwwang.github.io/scplotter/reference/EnrichmentPlot.html>.
         enrich_plots (type=json): Cases of the plots to generate for the enrichment analysis.
             The keys are the names of the cases and the values are the dicts inherited from `enrich_plots_defaults`.
             The cases under `envs.cases` can inherit this options.
@@ -1781,6 +1787,11 @@ class CellTypeAnnotation(Proc):
             the original cell types will be kept and nothing will be changed.
             ///
 
+        more_cell_types (type=json): The additional cell type annotations to add to the metadata.
+            The keys are the new column names and the values are the cell types lists.
+            The cell type lists work the same as `cell_types` above.
+            This is useful when you want to keep multiple annotations of cell types.
+
         sccatch_args (ns): The arguments for `scCATCH::findmarkergene()` if `tool` is `sccatch`.
             - species: The specie of cells.
             - cancer: If the sample is from cancer tissue, then the cancer type may be defined.
@@ -1842,6 +1853,7 @@ class CellTypeAnnotation(Proc):
         "sctype_tissue": None,
         "sctype_db": config.ref.sctype_db,
         "cell_types": [],
+        "more_cell_types": None,
         "sccatch_args": {
             "species": None,
             "cancer": "Normal",
@@ -2524,6 +2536,10 @@ class CellCellCommunicationPlots(Proc):
         cases (type=json): The cases for the plots.
             The keys are the names of the cases and the values are the arguments for
             the plots. The arguments include the ones inherited from `envs`.
+            You can have a special `plot_type` `"table"` to generate a table for the
+            ccc data to save as a text file and show in the report.
+            If no cases are given, a default case will be used, with the
+            key `Cell-Cell Communication`.
         <more>: Other arguments passed to
             [scplotter::CCCPlot](https://pwwang.github.io/scplotter/reference/CCCPlot.html)
     """  # noqa: E501
@@ -2706,6 +2722,7 @@ class PseudoBulkDEG(Proc):
             analysis.
 
     Envs:
+        ncores (type=int): Number of cores to use for parallelization.
         mutaters (type=json): Mutaters to mutate the metadata of the
             seurat object. Keys are the new column names and values are the
             expressions to mutate the columns. These new columns can be
@@ -2715,6 +2732,9 @@ class PseudoBulkDEG(Proc):
         each: The column name in metadata to separate the cells into different cases.
             When specified, the case will be expanded to multiple cases for
             each value in the column.
+        cache (type=auto): Where to cache the results.
+            If `True`, cache to `outdir` of the job. If `False`, don't cache.
+            Otherwise, specify the directory to cache to.
         subset: An expression in string to subset the cells.
         aggregate_by: The column names in metadata to aggregate the cells.
         layer: The layer to pull and aggregate the data.
@@ -2844,7 +2864,9 @@ class PseudoBulkDEG(Proc):
     lang = config.lang.rscript
     script = "file://../scripts/scrna/PseudoBulkDEG.R"
     envs = {
+        "ncores": config.misc.ncores,
         "mutaters": {},
+        "cache": config.path.tmpdir,
         "each": None,
         "subset": None,
         "aggregate_by": None,

{biopipen-0.34.7 → biopipen-0.34.9}/biopipen/scripts/regulatory/MotifAffinityTest.R

@@ -14,6 +14,7 @@ bcftools <- {{envs.bcftools | r}}
 genome <- {{envs.genome | r}}
 motif_col <- {{envs.motif_col | r}}
 regulator_col <- {{envs.regulator_col | r}}
+var_col <- {{envs.var_col | r}}
 notfound <- {{envs.notfound | r}}
 motifdb <- {{envs.motifdb | r}}
 regmotifs <- {{envs.regmotifs | r}}
@@ -21,6 +22,7 @@ devpars <- {{envs.devpars | r}}
 plot_nvars <- {{envs.plot_nvars | r}}
 plots <- {{envs.plots | r}}
 cutoff <- {{envs.cutoff | r}}
+set.seed(8525)
 
 if (is.null(motifdb) || !file.exists(motifdb)) {
     stop("Motif database (envs.motifdb) is required and must exist")
@@ -47,10 +49,21 @@ log <- get_logger()
 log$info("Reading input regulator/motif file ...")
 in_motifs <- read.table(motiffile, header=TRUE, sep="\t", stringsAsFactors=FALSE, check.names = FALSE)
 
+
 log$info("Ensuring motifs and regulators in the input data ...")
-in_motifs <- ensure_regulator_motifs(in_motifs, outdir, motif_col, regulator_col, regmotifs, notfound = notfound)
+in_motifs <- ensure_regulator_motifs(in_motifs, outdir, motif_col, regulator_col, var_col, regmotifs, notfound = notfound)
 genome_pkg <- get_genome_pkg(genome)
 
+motif_var_pairs <- NULL
+if (!is.null(var_col)) {
+    log$info("Obtaining motif-variant pairs to test ...")
+    if (!var_col %in% colnames(in_motifs)) {
+        stop("Variant column (envs.var_col) not found in the input motif file")
+    }
+
+    motif_var_pairs <- unique(paste0(in_motifs[[motif_col]], " // ", in_motifs[[var_col]]))
+}
+
 log$info("Reading variant file ...")
 if (grepl("\\.vcf$", varfile) || grepl("\\.vcf\\.gz$", varfile)) {
     log$info("Converting VCF file to BED file ...")
@@ -77,10 +90,13 @@ mdb <- read_meme_to_motifdb(motifdb, in_motifs, motif_col, regulator_col, notfou
 tool <- tolower(tool)
 tool <- match.arg(tool, c("motifbreakr", "atsnp"))
 
-if (tool == "motifbreakr") {
+{% if envs.tool == "motifbreakr" %}
     motifbreakr_args <- {{envs.motifbreakr_args | r}}
     {% include biopipen_dir + "/scripts/regulatory/MotifAffinityTest_MotifBreakR.R" %}
-} else {  # atsnp
-    atsnp_args <- {{envs.atsnp_args | r}}
+{% else %}
+    atsnp_args <- list_update(
+        list(padj_cutoff = TRUE, padj = "BH", p = "Pval_diff"),
+        {{envs.atsnp_args | r}}
+    )
     {% include biopipen_dir + "/scripts/regulatory/MotifAffinityTest_AtSNP.R" %}
-}
+{% endif %}

{biopipen-0.34.7 → biopipen-0.34.9}/biopipen/scripts/regulatory/MotifAffinityTest_AtSNP.R

@@ -46,6 +46,13 @@ atsnp_result <- ComputePValues(
     testing.mc = TRUE
 )
 
+if (!is.null(motif_var_pairs)) {
+    log$info("Filtering motif-variant pairs ...")
+    atsnp_result$motifs_vars <- paste0(atsnp_result$motif, " // ", atsnp_result$snpid)
+    atsnp_result <- atsnp_result[atsnp_result$motifs_vars %in% motif_var_pairs, , drop = FALSE]
+    atsnp_result$motifs_vars <- NULL
+}
+
 padj_col <- paste0(atsnp_args$p, "_adj")
 atsnp_result[[padj_col]] <- p.adjust(atsnp_result[[atsnp_args$p]], method = atsnp_args$padj)
 cutoff_col <- if (atsnp_args$padj_cutoff) padj_col else atsnp_args$p
@@ -87,7 +94,8 @@ write.table(
 
 log$info("Plotting variants ...")
 # Convert result to GRanges object
-atsnp_result$alleleDiff <- -atsnp_result[[cutoff_col]]
+atsnp_result$alleleDiff <- -log10(atsnp_result[[cutoff_col]])
+atsnp_result <- atsnp_result[order(-atsnp_result$alleleDiff), , drop = FALSE]
 atsnp_result$effect <- "strong"
 atsnp_result$motifPos <- lapply(atsnp_result$motifPos, function(x) as.integer(unlist(strsplit(x, ","))))
 atsnp_result <- makeGRangesFromDataFrame(atsnp_result, keep.extra.columns = TRUE, starts.in.df.are.0based = TRUE)
@@ -96,7 +104,6 @@ attributes(atsnp_result)$genome.package <- genome_pkg
 attributes(atsnp_result)$motifs <- mdb
 
 if (is.null(plots) || length(plots) == 0) {
-    atsnp_result <- atsnp_result[order(-abs(atsnp_result$alleleDiff)), , drop = FALSE]
     atsnp_result <- atsnp_result[1:min(plot_nvars, length(atsnp_result)), , drop = FALSE]
     variants <- unique(atsnp_result$SNP_id)
 } else {

{biopipen-0.34.7 → biopipen-0.34.9}/biopipen/scripts/regulatory/MotifAffinityTest_MotifBreakR.R

@@ -50,6 +50,7 @@ results <- motifbreakR(
 
 log$info("Calculating p values ...")
 results <- calculatePvalue(results)
+results$.id <- 1:length(results)
 results_to_save <- as.data.frame(unname(results))
 results_to_save$motifPos <- lapply(results_to_save$motifPos, function(x) paste(x, collapse = ","))
 results_to_save$altPos <- lapply(results_to_save$altPos, function(x) paste(x, collapse = ","))
@@ -60,20 +61,28 @@ if (!is.null(regulator_col)) {
         drop = TRUE
     ]
 }
-results_to_save <- apply(results_to_save, 2, as.character)
+results_to_save <- as.data.frame(apply(results_to_save, 2, as.character))
+
+if (!is.null(motif_var_pairs)) {
+    log$info("Filtering motif-variant pairs ...")
+    results_to_save$motifs_vars <- paste0(results_to_save$providerId, " // ", results_to_save$SNP_id)
+    results_to_save <- results_to_save[results_to_save$motifs_vars %in% motif_var_pairs, , drop = FALSE]
+    results_to_save$motifs_vars <- NULL
+}
 
 write.table(
     results_to_save,
     file = file.path(outdir, "motifbreakr.txt"),
     sep = "\t", quote = FALSE, row.names = FALSE
 )
-rm(results_to_save)
+# rm(results_to_save)
 
 log$info("Plotting variants ...")
 if (is.null(plots) || length(plots) == 0) {
-    results <- results[order(-abs(results$alleleDiff)), , drop = FALSE]
-    results <- results[1:min(plot_nvars, length(results)), , drop = FALSE]
-    variants <- unique(results$SNP_id)
+    results_to_save$alleleDiff <- as.numeric(results_to_save$alleleDiff)
+    results_to_save <- results_to_save[order(-abs(results_to_save$alleleDiff)), , drop = FALSE]
+    results_to_save <- results_to_save[1:min(plot_nvars, nrow(results_to_save)), , drop = FALSE]
+    variants <- unique(results_to_save$SNP_id)
 } else {
     variants <- names(plots)
 }
@@ -88,7 +97,7 @@ for (variant in variants) {
     if (is.null(plots[[variant]]$devpars)) {
         plots[[variant]]$devpars <- devpars
     }
-    res <- results[results$SNP_id == variant, , drop = FALSE]
+    res <- results[results$SNP_id == variant & results$.id %in% results_to_save$.id, , drop = FALSE]
     res <- subset(res, subset = eval(parse(text = plots[[variant]]$which)))
 
     plot_variant_motifs(res, variant, plots[[variant]]$devpars, outdir)

{biopipen-0.34.7 → biopipen-0.34.9}/biopipen/scripts/regulatory/VariantMotifPlot.R

@@ -33,7 +33,7 @@ log$info("Reading input data ...")
 indata <- read.table(infile, header=TRUE, sep="\t", stringsAsFactors=FALSE, check.names = FALSE)
 
 log$info("Ensuring regulators in the input data ...")
-indata <- ensure_regulator_motifs(indata, outdir, motif_col, regulator_col, regmotifs, notfound = notfound)
+indata <- ensure_regulator_motifs(indata, outdir, motif_col, regulator_col, "SNP_id", regmotifs, notfound = notfound)
 genome_pkg <- get_genome_pkg(genome)
 
 log$info("Reading motif database ...")

{biopipen-0.34.7 → biopipen-0.34.9}/biopipen/scripts/regulatory/motifs-common.R

@@ -138,12 +138,13 @@ motifdb_to_motiflib <- function(motifdb) {
 #' @param outdir Output directory, used to save un-matched regulators
 #' @param motif_col Column name for the motif
 #' @param regulator_col Column name for the regulator
+#' @param var_col Column name for the variant
 #' @param regmotifs Regulator-motif mapping file
 #' @param log_indent Indentation for log messages
 #' @param notfound Action to take if regulators are not found in the mapping file
 #' @return Data frame with regulators and motifs
 #' @export
-ensure_regulator_motifs <- function (indata, outdir, motif_col, regulator_col, regmotifs, log_indent = "", notfound = "error", log = NULL) {
+ensure_regulator_motifs <- function (indata, outdir, motif_col, regulator_col, var_col, regmotifs, log_indent = "", notfound = "error", log = NULL) {
     if (is.null(motif_col)) {
         if (is.null(regmotifs)) {
             stop("Regulator-motif mapping file (envs.regmotifs) is required when no motif column (envs.motif_col) is provided")
@@ -198,7 +199,7 @@ ensure_regulator_motifs <- function (indata, outdir, motif_col, regulator_col, r
             regulator_col <<- rm_reg_col
         }
     } else {
-        indata <- indata[!duplicated(indata[, c(regulator_col, motif_col), drop = FALSE]), , drop = FALSE]
+        indata <- indata[!duplicated(indata[, c(regulator_col, motif_col, var_col), drop = FALSE]), , drop = FALSE]
     }
 
     return(indata)

{biopipen-0.34.7 → biopipen-0.34.9}/biopipen/scripts/scrna/CellCellCommunication.py

@@ -7,6 +7,10 @@ import scanpy
 import liana
 import liana.method.sc._liana_pipe as _liana_pipe
 
+# AttributeError: module 'numpy' has no attribute 'product'
+if not hasattr(np, "product"):
+    np.product = np.prod
+
 # monkey-patch liana.method.sc._liana_pipe._trimean due to the updates by scipy 1.14
 # https://github.com/scipy/scipy/commit/a660202652deead0f3b4b688eb9fdcdf9f74066c
 def _trimean(a, axis=0):

{biopipen-0.34.7 → biopipen-0.34.9}/biopipen/scripts/scrna/CellCellCommunicationPlots.R

@@ -27,7 +27,7 @@ defaults <- list(
     devpars = list(res = 100)
 )
 
-cases <- expand_cases(cases, defaults)
+cases <- expand_cases(cases, defaults, default_case = "Cell-Cell Communication")
 log <- get_logger()
 reporter <- get_reporter()
 
@@ -35,12 +35,31 @@ do_case <- function(name) {
     log$info("- Case: {name}")
     case <- cases[[name]]
     info <- case_info(name, outdir, is_dir = FALSE)
-    case <- extract_vars(case, "subset", "devpars", "more_formats", "descr")
+    case <- extract_vars(case, subset_ = "subset", "devpars", "more_formats", "descr")
 
     case$data <- ccc
-    if (!is.null(case$subset)) {
-        case$data <- ccc %>% dplyr::filter(!!parse_expr(case$subset))
+    if (!is.null(subset_)) {
+        case$data <- ccc %>% dplyr::filter(!!parse_expr(subset_))
     }
+
+    if (identical(case$plot_type, "table")) {
+        write.table(
+            case$data,
+            file = paste0(info$prefix, ".txt"),
+            sep = "\t",
+            row.names = FALSE,
+            col.names = TRUE,
+            quote = FALSE
+        )
+        report <- list(
+            kind = "table",
+            data = list(nrows = 100),
+            src = paste0(info$prefix, ".txt")
+        )
+        reporter$add2(report, hs = c(info$section, info$name))
+        return()
+    }
+
     if (is.null(case$magnitude)) {
         case$magnitude <- NULL
     }

{biopipen-0.34.7 → biopipen-0.34.9}/biopipen/scripts/scrna/CellTypeAnnotation-direct.R

@@ -5,11 +5,15 @@ outfile <- {{out.outfile | r}}
 celltypes <- {{envs.cell_types | r}}
 newcol <- {{envs.newcol | r}}
 merge_same_labels <- {{envs.merge | r}}
+more_cell_types <- {{envs.more_cell_types | r}}
 
 log <- biopipen.utils::get_logger()
 
 if (is.null(celltypes) || length(celltypes) == 0) {
     log$warn("No cell types are given!")
+    if (!is.null(more_cell_types) && length(more_cell_types) > 0) {
+        log$warn("`envs.celltypes` is not given, won't process `envs.more_cell_types`!")
+    }
 
     if (merge_same_labels) {
         log$warn("Ignoring 'envs.merge' because no cell types are given!")
@@ -25,26 +29,43 @@ if (is.null(celltypes) || length(celltypes) == 0) {
     } else {
         idents <- as.character(unique(idents))
     }
-
-    if (length(celltypes) < length(idents)) {
-        celltypes <- c(celltypes, idents[(length(celltypes) + 1):length(idents)])
-    } else if (length(celltypes) > length(idents)) {
-        celltypes <- celltypes[1:length(idents)]
-        log$warn("The length of cell types is longer than the number of clusters!")
+    process_celltypes <- function(ct, key = NULL) {
+        if (length(ct) < length(idents)) {
+            ct <- c(ct, idents[(length(ct) + 1):length(idents)])
+        } else if (length(ct) > length(idents)) {
+            ct <- ct[1:length(idents)]
+            if (is.null(key)) {
+                log$warn("The length of cell types is longer than the number of clusters!")
+            } else {
+                log$warn(paste0("The length of cell types for '", key, "' is longer than the number of clusters!"))
+            }
+        }
+        for (i in seq_along(ct)) {
+            if (ct[i] == "-" || ct[i] == "") {
+                ct[i] <- idents[i]
+            }
+        }
+        names(ct) <- idents
+        return(ct)
     }
-    for (i in seq_along(celltypes)) {
-        if (celltypes[i] == "-" || celltypes[i] == "") {
-            celltypes[i] <- idents[i]
+
+    if (!is.null(more_cell_types) && length(more_cell_types) > 0) {
+        for (key in names(more_cell_types)) {
+            ct <- more_cell_types[[key]]
+            ct <- process_celltypes(ct, key)
+            log$info(paste0("Adding additional cell type annotation: '", key, "' ..."))
+            sobj@meta.data[[key]] <- ct[as.character(Idents(sobj))]
         }
     }
-    names(celltypes) <- idents
+
+    celltypes <- process_celltypes(celltypes)
 
     log$info("Renaming cell types ...")
     if (is.null(newcol)) {
         has_na <- "NA" %in% unlist(celltypes) || anyNA(unlist(celltypes))
         sobj$seurat_clusters_id <- Idents(sobj)
         celltypes$object <- sobj
-        sobj <- do_call(RenameIdents, celltypes)
+        sobj <- biopipen.utils::do_call(RenameIdents, celltypes)
         sobj$seurat_clusters <- Idents(sobj)
         if (has_na) {
             log$info("Filtering clusters if NA ...")
@@ -65,5 +86,6 @@ if (is.null(celltypes) || length(celltypes) == 0) {
         sobj <- merge_clusters_with_same_labels(sobj, newcol)
     }
 
+    log$info("Saving Seurat object ...")
     biopipen.utils::save_obj(sobj, outfile)
 }

{biopipen-0.34.7 → biopipen-0.34.9}/biopipen/scripts/scrna/MarkersFinder.R

@@ -268,20 +268,22 @@ process_markers <- function(markers, info, case) {
         ui = "tabs"
     )
 
-    for (plotname in names(case$marker_plots)) {
-        plotargs <- case$marker_plots[[plotname]]
-        plotargs$degs <- markers
-        rownames(plotargs$degs) <- make.unique(markers$gene)
-        plotargs$outprefix <- file.path(info$prefix, paste0("markers.", slugify(plotname)))
-        do_call(VizDEGs, plotargs)
-        reporter$add2(
-            list(
-                name = plotname,
-                contents = list(reporter$image(plotargs$outprefix, plotargs$more_formats, plotargs$save_code))),
-            hs = c(info$section, info$name),
-            hs2 = ifelse(is.null(case$ident), "Markers", paste0("Markers (", case$ident, ")")),
-            ui = "tabs"
-        )
+    if (nrow(markers) > 0) {
+        for (plotname in names(case$marker_plots)) {
+            plotargs <- case$marker_plots[[plotname]]
+            plotargs$degs <- markers
+            rownames(plotargs$degs) <- make.unique(markers$gene)
+            plotargs$outprefix <- file.path(info$prefix, paste0("markers.", slugify(plotname)))
+            do_call(VizDEGs, plotargs)
+            reporter$add2(
+                list(
+                    name = plotname,
+                    contents = list(reporter$image(plotargs$outprefix, plotargs$more_formats, plotargs$save_code))),
+                hs = c(info$section, info$name),
+                hs2 = ifelse(is.null(case$ident), "Markers", paste0("Markers (", case$ident, ")")),
+                ui = "tabs"
+            )
+        }
     }
 
     # Do enrichment analysis
@@ -351,16 +353,24 @@ process_markers <- function(markers, info, case) {
                 for (db in case$dbs) {
                     plots <- list()
                     for (plotname in names(case$enrich_plots)) {
-                        plotargs <- case$enrich_plots[[plotname]]
+                        plotargs <- extract_vars(case$enrich_plots[[plotname]], "descr", allow_nonexisting = TRUE)
                         plotargs$data <- enrich[enrich$Database == db, , drop = FALSE]
 
                         p <- do_call(VizEnrichment, plotargs)
 
                         if (plotargs$plot_type == "bar") {
                             attr(p, "height") <- attr(p, "height") / 1.5
+                            descr <- descr %||% glue::glue(
+                                "The bar plot shows the top enriched terms in database '{db}', ",
+                                "the x-axis shows the -log10 of the adjusted p-values, ",
+                                "and the y-axis shows the term names. The number next to each bar indicates the overlap gene count."
+                            )
                         }
                         outprefix <- file.path(info$prefix, paste0("enrich.", slugify(db), ".", slugify(plotname)))
                         save_plot(p, outprefix, plotargs$devpars, formats = "png")
+                        if (!is.null(descr)) {
+                            plots[[length(plots) + 1]] <- list(kind = "descr", content = glue::glue(descr))
+                        }
                         plots[[length(plots) + 1]] <- reporter$image(outprefix, c(), FALSE)
                     }
                     reporter$add2(
@@ -399,6 +409,10 @@ process_allmarkers <- function(markers, plotcases, casename, groupname) {
         plotargs <- plotcases[[plotname]]
         plotargs$degs <- markers
         plotargs$outprefix <- file.path(info$prefix, slugify(plotname))
+        if (identical(plotargs$plot_type, "heatmap")) {
+            plotargs$show_row_names = plotargs$show_row_names %||% TRUE
+            plotargs$show_column_names = plotargs$show_column_names %||% TRUE
+        }
         do_call(VizDEGs, plotargs)
         reporter$add2(
             list(
@@ -547,7 +561,9 @@ run_case <- function(name) {
                 attr(markers, "group_by") <- each
                 attr(markers, "ident_1") <- NULL
                 attr(markers, "ident_2") <- NULL
-                process_allmarkers(markers, allmarker_plots, name, each)
+                if (!is.null(markers) && nrow(markers) > 0) {
+                    process_allmarkers(markers, allmarker_plots, name, each)
+                }
             }
 
             if (length(overlaps) > 0) {
@@ -557,7 +573,7 @@ run_case <- function(name) {
 
         }
 
-        if (!is.null(enriches)) {
+        if (!is.null(enriches) && length(enriches) > 0) {
             log$info("- Summarizing enrichments in subcases (by each: {each}) ...")
             if (!is.data.frame(enriches)) {
                 each_levels <- names(enriches)
@@ -573,7 +589,7 @@ run_case <- function(name) {
                 enriches[[each]] <- factor(enriches[[each]], levels = each_levels)
             }
 
-            if (length(allenrich_plots) > 0) {
+            if (length(allenrich_plots) > 0 && !is.null(enriches) && nrow(enriches) > 0) {
                 log$info("- Visualizing all enrichments together ...")
                 process_allenriches(enriches, allenrich_plots, name, each)
             }
@@ -636,7 +652,9 @@ run_case <- function(name) {
         ))
 
         if (!is.null(original_case) && !is.null(cases[[original_case]])) {
-            markers[[each_name]] <- each
+            if (nrow(markers) > 0) {
+                markers[[each_name]] <- each
+            }
             cases[[original_case]]$markers[[each]] <<- markers
             cases[[original_case]]$enriches[[each]] <<- enrich
         }

{biopipen-0.34.7 → biopipen-0.34.9}/biopipen/scripts/scrna/ModuleScoreCalculator.R

@@ -1,11 +1,13 @@
-library(Seurat)
+library(rlang)
 library(dplyr)
+library(Seurat)
 library(biopipen.utils)
 
 sobjfile <- {{in.srtobj | r}}
 outfile <- {{out.rdsfile | r}}
 defaults <- {{envs.defaults | r}}
 modules <- {{envs.modules | r}}
+post_mutaters <- {{envs.post_mutaters | r}}
 
 log <- get_logger()
 
@@ -134,6 +136,12 @@ for (key in names(modules)) {
     }
 }
 
+if (!is.null(post_mutaters) && length(post_mutaters) > 0) {
+    log$info("Applying post mutaters ...")
+    sobj@meta.data <- sobj@meta.data %>%
+        mutate(!!!lapply(post_mutaters, parse_expr))
+}
+
 # save seurat object
 log$info("Saving Seurat object ...")
 save_obj(sobj, outfile)