biopipen 0.21.0__py3-none-any.whl → 0.34.26__py3-none-any.whl

biopipen/scripts/scrna/MarkersFinder.R

@@ -1,467 +1,746 @@
-source("{{biopipen_dir}}/utils/misc.R")
-source("{{biopipen_dir}}/utils/mutate_helpers.R")
-
 library(rlang)
 library(dplyr)
-library(tidyr)
-library(tibble)
 library(Seurat)
-library(enrichR)
-library(ggplot2)
-library(ggprism)
-library(ggrepel)
-library(future)
 library(tidyseurat)
-library(ggVennDiagram)
-library(UpSetR)
+library(plotthis)
+library(biopipen.utils)
+
+log <- get_logger()
+reporter <- get_reporter()
 
-log_info("Setting up EnrichR ...")
-setEnrichrSite("Enrichr")
+srtfile <- {{ in.srtobj | r }}
+outdir <- {{ out.outdir | r }}
+joboutdir <- {{ job.outdir | r }}
 
-srtfile <- {{ in.srtobj | quote }}
-outdir <- {{ out.outdir | quote }}
 ncores <- {{ envs.ncores | int }}
 mutaters <- {{ envs.mutaters | r }}
-ident.1 <- {{ envs["ident-1"] | r }}
-ident.2 <- {{ envs["ident-2"] | r }}
-group.by <- {{ envs["group-by"] | r }}
+group_by <- {{ envs.group_by | default: envs["group-by"] | default: None | r }}
+ident_1 <- {{ envs.ident_1 | default: envs["ident-1"] | default: None | r }}
+ident_2 <- {{ envs.ident_2 | default: envs["ident-2"] | default: None | r }}
 each <- {{ envs.each | r }}
-prefix_each <- {{ envs.prefix_each | r }}
-section <- {{ envs.section | r }}
 dbs <- {{ envs.dbs | r }}
-assay <- {{ envs.assay | r }}
 sigmarkers <- {{ envs.sigmarkers | r }}
-volcano_genes <- {{ envs.volcano_genes | r }}
+enrich_style <- {{ envs.enrich_style | r }}
+assay <- {{ envs.assay | r }}
+error <- {{ envs.error | r }}
 subset <- {{ envs.subset | r }}
+cache <- {{ envs.cache | r }}
 rest <- {{ envs.rest | r: todot="-" }}
-dotplot <- {{ envs.dotplot | r: todot="-" }}
-cases <- {{ envs.cases | r: todot="-" }}
-overlap <- {{ envs.overlap | r }}
-
-overlaps <- list()
+allmarker_plots_defaults <- {{ envs.allmarker_plots_defaults | r }}
+allmarker_plots <- {{ envs.allmarker_plots | r }}
+allenrich_plots_defaults <- {{ envs.allenrich_plots_defaults | r }}
+allenrich_plots <- {{ envs.allenrich_plots | r }}
+marker_plots_defaults <- {{ envs.marker_plots_defaults | r }}
+marker_plots <- {{ envs.marker_plots | r }}
+enrich_plots_defaults <- {{ envs.enrich_plots_defaults | r }}
+enrich_plots <- {{ envs.enrich_plots | r }}
+overlaps_defaults <- {{ envs.overlaps_defaults | r }}
+overlaps <- {{ envs.overlaps | r }}
+cases <- {{ envs.cases | r: todot="-", skip=1 }}
 
-if (is.character(volcano_genes) && length(volcano_genes) == 1) {
-    volcano_genes <- trimws(strsplit(volcano_genes, ",")[[1]])
-}
+if (isTRUE(cache)) { cache <- joboutdir }
 
 set.seed(8525)
 if (ncores > 1) {
-    options(future.globals.maxSize = 80000 * 1024^2)
+    options(future.globals.maxSize = Inf)
     plan(strategy = "multicore", workers = ncores)
 }
 
-log_info("Reading Seurat object ...")
-srtobj <- readRDS(srtfile)
+log$info("Reading Seurat object ...")
+srtobj <- read_obj(srtfile)
+
 
-log_info("Mutate meta data if needed ...")
 if (!is.null(mutaters) && length(mutaters) > 0) {
+    log$info("Mutating meta data ...")
     srtobj@meta.data <- srtobj@meta.data %>%
         mutate(!!!lapply(mutaters, parse_expr))
 }
 
-log_info("Expanding cases ...")
-if (is.null(cases) || length(cases) == 0) {
-    cases <- list(
-        DEFAULT = list(
-            ident.1 = ident.1,
-            ident.2 = ident.2,
-            group.by = group.by,
-            each = each,
-            prefix_each = prefix_each,
-            section = section,
-            dbs = dbs,
-            assay = assay,
-            subset = subset,
-            sigmarkers = sigmarkers,
-            volcano_genes = volcano_genes,
-            dotplot = dotplot,
-            rest = rest
+allmarker_plots <- lapply(allmarker_plots, function(x) {
+    list_update(allmarker_plots_defaults, x)
+})
+allenrich_plots <- lapply(allenrich_plots, function(x) {
+    list_update(allenrich_plots_defaults, x)
+})
+marker_plots <- lapply(marker_plots, function(x) {
+    list_update(marker_plots_defaults, x)
+})
+enrich_plots <- lapply(enrich_plots, function(x) {
+    list_update(enrich_plots_defaults, x)
+})
+overlaps <- lapply(overlaps, function(x) {
+    list_update(overlaps_defaults, x)
+})
+
+defaults <- list(
+    group_by = group_by,
+    ident_1 = ident_1,
+    ident_2 = ident_2,
+    dbs = dbs,
+    sigmarkers = sigmarkers,
+    enrich_style = enrich_style,
+    assay = assay %||% DefaultAssay(srtobj),
+    each = each,
+    error = error,
+    subset = subset,
+    allmarker_plots_defaults = allmarker_plots_defaults,
+    allmarker_plots = allmarker_plots,
+    allenrich_plots_defaults = allenrich_plots_defaults,
+    allenrich_plots = allenrich_plots,
+    marker_plots_defaults = marker_plots_defaults,
+    marker_plots = marker_plots,
+    enrich_plots_defaults = enrich_plots_defaults,
+    enrich_plots = enrich_plots,
+    overlaps_defaults = overlaps_defaults,
+    overlaps = overlaps,
+    cache = cache,
+    rest = rest
+)
+
+log$info("Expanding cases ...")
+
+post_casing <- function(name, case) {
+    outcases <- list()
+
+    case$group_by <- case$group_by %||% GetIdentityColumn(srtobj)
+
+    if (is.null(case$each) || is.na(case$each) || nchar(case$each) == 0 || isFALSE(each)) {
+        # single cases, no need to expand
+        if (length(case$ident_1) > 0 && length(case$overlaps) > 0) {
+            stop("Cannot perform 'overlaps' with a single comparison (ident-1 is set) in case '", name, "'")
+        }
+        if (length(case$ident_1) > 0 && length(case$allmarker_plots) > 0) {
+            stop("Cannot perform 'allmarker_plots' with a single comparison (ident-1 is set) in case '", name, "'")
+        }
+        if (length(case$ident_1) > 0 && length(case$allenrich_plots) > 0) {
+            stop("Cannot perform 'allenrich_plots' with a single comparison (ident-1 is set) in case '", name, "'")
+        }
+
+        case$allmarker_plots <- lapply(
+            case$allmarker_plots,
+            function(x) { list_update(case$allmarker_plots_defaults, x) }
         )
-    )
-} else {
-    for (name in names(cases)) {
-        case <- list_setdefault(
-            cases[[name]],
-            ident.1 = ident.1,
-            ident.2 = ident.2,
-            group.by = group.by,
-            each = each,
-            prefix_each = prefix_each,
-            section = section,
-            dbs = dbs,
-            assay = assay,
-            subset = subset,
-            sigmarkers = sigmarkers,
-            volcano_genes = volcano_genes,
-            dotplot = dotplot,
-            rest = rest
+        case$allmarker_plots_defaults <- NULL
+
+        case$allenrich_plots <- lapply(
+            case$allenrich_plots,
+            function(x) { list_update(case$allenrich_plots_defaults, x) }
         )
-        case$rest <- list_update(rest, case$rest)
-        case$dotplot$devpars <- list_update(dotplot$devpars, case$dotplot$devpars)
-        cases[[name]] <- case
-    }
-}
-# Expand each and with ident.1
-#  list(Cluster0 = list(each = "Sample", group.by = "seurat_clusters", ident.1 = "0"))
-# to
-#  list(
-#   `Sample-Sample1:Cluster0` = list(...),
-#   `Sample-Sample2:Cluster0` = list(...),
-#   ...
-#  )
-# Expand each and without ident.1
-#  list(Cluster = list(each = "Sample", group.by = "seurat_clusters"))
-# to
-#  list(
-#   `Sample-Sample1-Cluster:0` = list(...),
-#   `Sample-Sample1-Cluster:1` = list(...),
-#   ...
-#   `Sample2-Cluster:0` = list(...),
-#   `Sample2-Cluster:1` = list(...),
-#   ...
-#  )
-# If no each, and not ident.1
-#  list(Cluster = list(group.by = "seurat_clusters"))
-# to
-#  list(
-#   `Cluster:0` = list(...),
-#   `Cluster:1` = list(...),
-#   ...
-#  )
-# Otherwise if section is specified, the case name will be changed to `section:case`
-
-newcases <- list()
-for (name in names(cases)) {
-    case <- cases[[name]]
-    if (is.null(case$each) && !is.null(case$ident.1)) {
-        newcases[[paste0(case$section, ":", name)]] <- case
-    } else if (is.null(case$each)) {
-        # is.null(case$ident.1)
-        idents <- srtobj@meta.data %>% pull(case$group.by) %>% unique() %>% na.omit()
-        for (ident in idents) {
-            newcases[[paste0(name, ":", ident)]] <- case
-            newcases[[paste0(name, ":", ident)]]$ident.1 <- ident
+        case$allenrich_plots_defaults <- NULL
+
+        case$marker_plots <- lapply(
+            case$marker_plots,
+            function(x) { list_update(case$marker_plots_defaults, x) }
+        )
+        case$marker_plots_defaults <- NULL
+
+        case$enrich_plots <- lapply(
+            case$enrich_plots,
+            function(x) { list_update(case$enrich_plots_defaults, x) }
+        )
+        case$enrich_plots_defaults <- NULL
+
+        case$overlaps <- lapply(
+            case$overlaps,
+            function(x) { list_update(case$overlaps_defaults, x) }
+        )
+        case$overlaps_defaults <- NULL
+
+        outcases[[name]] <- case
+    } else {  # !no_each
+        eachs <- if (!is.null(case$subset)) {
+            srtobj@meta.data %>%
+                filter(!!parse_expr(case$subset)) %>%
+                pull(case$each) %>% na.omit() %>% unique() %>% as.vector()
+        } else {
+            srtobj@meta.data %>%
+                pull(case$each) %>% na.omit() %>% unique() %>% as.vector()
         }
-    } else {
-        eachs <- srtobj@meta.data %>% pull(case$each) %>% unique() %>% na.omit()
+        if (length(case$overlaps) > 0 && is.null(case$ident_1)) {
+            stop("Cannot perform 'overlaps' analysis with 'each' and without 'ident_1' in case '", name, "'")
+        }
+
+        if (length(cases) == 0 && name == "Marker Discovery") {
+            name <- case$each
+        } else {
+            name <- paste0(name, " (", case$each, ")")
+        }
+
         for (each in eachs) {
-            by = make.names(paste0(".", name, "_", each))
-            srtobj@meta.data = srtobj@meta.data %>% mutate(
-                !!sym(by) := if_else(
-                    !!sym(case$each) == each,
-                    !!sym(case$group.by),
-                    NA
-                )
-            )
-            if (is.null(case$ident.1)) {
-                idents <- srtobj@meta.data %>% pull(case$group.by) %>% unique() %>% na.omit()
-                for (ident in idents) {
-                    kname <- if (name == "DEFAULT") "" else paste0("-", name)
-                    key <- paste0(each, kname, ":", ident)
-                    if (case$prefix_each) {
-                        key <- paste0(case$each, "-", key)
-                    }
-                    newcases[[key]] <- case
-                    newcases[[key]]$ident.1 <- ident
-                    newcases[[key]]$group.by <- by
-                }
+            newname <- paste0(name, "::", each)
+            newcase <- case
+
+            newcase$original_case <- name
+            newcase$each_name <- case$each
+            newcase$each <- each
+            newcase$original_subset <- case$subset
+
+            if (!is.null(case$subset)) {
+                newcase$subset <- paste0(case$subset, " & ", bQuote(case$each), " == '", each, "'")
             } else {
-                key <- paste0(case$each, ":", each)
-                if (name != "DEFAULT") {
-                    key <- paste0(key, " - ", name)
-                }
-                newcases[[key]] <- case
-                newcases[[key]]$group.by <- by
+                newcase$subset <- paste0(bQuote(case$each), " == '", each, "'")
             }
+
+            newcase$marker_plots <- lapply(
+                case$marker_plots,
+                function(x) { list_update(case$marker_plots_defaults, x) }
+            )
+            newcase$marker_plots_defaults <- NULL
+
+            newcase$enrich_plots <- lapply(
+                case$enrich_plots,
+                function(x) { list_update(case$enrich_plots_defaults, x) }
+            )
+            newcase$enrich_plots_defaults <- NULL
+
+            # Will be processed by the case itself, which collects the markers
+            newcase$allmarker_plots <- NULL
+            newcase$allmarker_plots_defaults <- NULL
+            newcase$allenrich_plots <- NULL
+            newcase$allenrich_plots_defaults <- NULL
+            newcase$overlaps <- NULL
+            newcase$overlaps_defaults <- NULL
+
+            outcases[[newname]] <- newcase
         }
-    }
-}
-cases <- newcases
-
-plot_volcano = function(markers, volfile, sig, volgenes) {
-    # markers
-    #                  gene        p_val avg_log2FC pct.1 pct.2    p_val_adj
-    # 1            CCL5 1.883596e-11 -4.8282535 0.359 0.927 4.332270e-09
-    # 2        HLA-DQB1 3.667713e-09  6.1543174 0.718 0.098 8.435740e-07
-    # 3        HLA-DRB5 1.242993e-07  3.9032231 0.744 0.195 2.858885e-05
-    # 4           CD79B 2.036731e-07  4.2748835 0.692 0.146 4.684482e-05
-    log_info("- Plotting volcano plot ...")
-    markers = markers %>%
-        mutate(
-            Significant = if_else(
-                !!parse_expr(sig),
-                if_else(avg_log2FC > 0, "Up", "Down"),
-                "No"
-            ),
-            Label = if_else(
-                Significant != "No" & (isTRUE(volgenes) | (gene %in% volgenes)),
-                gene,
-                ""
+
+        if (length(case$overlaps) > 0 || length(case$allmarker_plots) > 0 || length(case$allenrich_plots) > 0) {
+            ovcase <- case
+
+            ovcase$markers <- list()
+            ovcase$allmarker_plots <- lapply(
+                ovcase$allmarker_plots,
+                function(x) { list_update(ovcase$allmarker_plots_defaults, x) }
             )
-        )
+            ovcase$allmarker_plots_defaults <- NULL
 
-    p_vol = ggplot(markers, aes(x = avg_log2FC, y = -log10(p_val_adj))) +
-        geom_point(aes(color = Significant), alpha = 0.75) +
-        scale_color_manual(
-            values = c(Up = "#FF3333", Down = "#3333FF", No = "#AAAAAA"),
-            labels = c(Up = "Up", Down = "Down", No = "Non-Significant")
-        ) +
-        geom_text_repel(
-            aes(label = Label),
-            size = 3,
-            color = "#000000",
-            box.padding = unit(0.35, "lines"),
-            point.padding = unit(0.5, "lines"),
-            segment.color = "#000000"
-        ) +
-        theme_prism() +
-        theme(legend.title=element_blank(), plot.margin=unit(c(1,1,1,1), "cm")) +
-        labs(
-            x = "log2 Fold Change",
-            y = "-log10 Adjusted P-value"
-        )
+            ovcase$enriches <- list()
+            ovcase$allenrich_plots <- lapply(
+                ovcase$allenrich_plots,
+                function(x) { list_update(ovcase$allenrich_plots_defaults, x) }
+            )
+            ovcase$allenrich_plots_defaults <- NULL
 
-    png(volfile, res = 100, height = 800, width = 900)
-    print(p_vol)
-    dev.off()
+            ovcase$overlaps <- lapply(
+                ovcase$overlaps,
+                function(x) { list_update(ovcase$overlaps_defaults, x) }
+            )
+            ovcase$overlaps_defaults <- NULL
+            outcases[[name]] <- ovcase
+        }
+    }
+    outcases
 }
+cases <- expand_cases(cases, defaults, post_casing, default_case = "Marker Discovery")
 
-# Do enrichment analysis for a case using Enrichr
-# Args:
-#   case: case name
-#   markers: markers dataframe
-#   sig: The expression to filter significant markers
-do_enrich <- function(case, markers, sig, volgenes) {
-    log_info("- Running enrichment for case: {case}")
-    parts <- strsplit(case, ":")[[1]]
-    sec <- parts[1]
-    case <- paste0(parts[-1], collapse = ":")
-    casedir <- file.path(outdir, sec, case)
-    dir.create(casedir, showWarnings = FALSE, recursive = TRUE)
-    if (nrow(markers) == 0) {
-        log_warn("  No markers found for case: {case}")
-        cat("No markers found.", file = file.path(casedir, "error.txt"))
-        return()
-    }
-    plot_volcano(markers, file.path(casedir, "volcano.png"), sig, volgenes)
-    markers_sig <- markers %>% filter(!!parse_expr(sig))
-    if (nrow(markers_sig) == 0) {
-        log_warn("  No significant markers found for case: {case}")
-        cat("No significant markers.", file = file.path(casedir, "error.txt"))
-        return()
-    }
-    write.table(
-        markers_sig,
-        file.path(casedir, "markers.txt"),
-        sep = "\t",
-        row.names = FALSE,
-        col.names = TRUE,
-        quote = FALSE
-    )
-    if (nrow(markers_sig) < 5) {
-        for (db in dbs) {
-            write.table(
-                data.frame(Warning = "Not enough significant markers."),
-                file.path(casedir, paste0("Enrichr-", db, ".txt")),
-                sep = "\t",
-                row.names = FALSE,
-                col.names = TRUE,
-                quote = FALSE
+log$info("Running cases ...")
+
+process_markers <- function(markers, info, case) {
+    ## Attributes lost
+    # markers <- markers %>%
+    #     mutate(gene = as.character(gene)) %>%
+    #     arrange(p_val_adj, desc(abs(avg_log2FC)))
+    markers$gene <- as.character(markers$gene)
+    markers <- markers[order(markers$p_val_adj, -abs(markers$avg_log2FC)), ]
+
+    # Save markers
+    write.table(markers, file.path(info$prefix, "markers.tsv"), sep = "\t", quote = FALSE, row.names = FALSE)
+
+    sigmarkers <- markers %>% filter(!!parse_expr(case$sigmarkers))
+    write.table(sigmarkers, file.path(info$prefix, "sigmarkers.tsv"), sep = "\t", quote = FALSE, row.names = FALSE)
+    reporter$add2(
+        list(
+            name = "Table",
+            contents = list(
+                list(kind = "descr", content = paste0(
+                    "Showing top 100 markers ordered by p_val_adj ascendingly, then abs(avg_log2FC) descendingly. ",
+                    "Use 'Download the entire data' button to download all significant markers by '",
+                    html_escape(case$sigmarkers), "'."
+                )),
+                list(kind = "table", src = file.path(info$prefix, "sigmarkers.tsv"), data = list(nrows = 100))
             )
-            png(
-                file.path(casedir, paste0("Enrichr-", db, ".png")),
-                res = 100, height = 200, width = 1000
+        ),
+        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$markers <- markers
+            plotargs$object <- case$object
+            plotargs$comparison_by <- case$group_by
+            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"
             )
-            print(
-                ggplot() +
-                    annotate(
-                        "text",
-                        x = 1,
-                        y = 1,
-                        label = "Not enough significant markers."
-                    ) +
-                    theme_classic()
+        }
+    }
+
+    # Do enrichment analysis
+    significant_markers <- unique(sigmarkers$gene)
+    empty <- if (case$enrich_style == "enrichr") {
+        data.frame(
+            Database = character(0),
+            Term = character(0),
+            Overlap = character(0),
+            P.value = numeric(0),
+            Adjusted.P.value = numeric(0),
+            Odds.Ratio = numeric(0),
+            Combined.Score = numeric(0),
+            Genes = character(0),
+            Rank = numeric(0)
+        )
+    } else {  # clusterProfiler
+        data.frame(
+            ID = character(0),
+            Description = character(0),
+            GeneRatio = character(0),
+            BgRatio = character(0),
+            Count = integer(0),
+            pvalue = numeric(0),
+            p.adjust = numeric(0),
+            qvalue = numeric(0),
+            geneID = character(0),
+            Database = character(0)
+        )
+    }
+
+    if (length(significant_markers) < 5) {
+        if (case$error) {
+            stop("Error: Not enough significant markers with '", case$sigmarkers, "' in case '", info$name, "' found (< 5) for enrichment analysis.")
+        } else {
+            message <- paste0("Not enough significant markers with '", case$sigmarkers, "' found (< 5) for enrichment analysis.")
+            log$warn("  ! Error: {message}")
+            reporter$add2(
+                list(
+                    name = "Warning",
+                    contents = list(list(kind = "error", content = message, kind_ = "warning"))),
+                hs = c(info$section, info$name),
+                hs2 = "Enrichment Analysis",
+                ui = "tabs"
             )
-            dev.off()
         }
+        return(empty)
     } else {
-        enriched <- enrichr(markers_sig$gene, dbs)
-        for (db in dbs) {
-            write.table(
-                enriched[[db]],
-                file.path(casedir, paste0("Enrichr-", db, ".txt")),
-                sep = "\t",
-                row.names = FALSE,
-                col.names = TRUE,
-                quote = FALSE
-            )
-            png(
-                file.path(casedir, paste0("Enrichr-", db, ".png")),
-                res = 100, height = 1000, width = 1000
+        tryCatch({
+            enrich <- RunEnrichment(
+                significant_markers,
+                dbs = case$dbs, style = case$enrich_style)
+
+            write.table(enrich, file.path(info$prefix, "enrich.tsv"), sep = "\t", quote = FALSE, row.names = FALSE)
+            reporter$add2(
+                list(
+                    name = "Table",
+                    contents = list(list(kind = "table", src = file.path(info$prefix, "enrich.tsv"), data = list(nrows = 100)))
+                ),
+                hs = c(info$section, info$name),
+                hs2 = "Enrichment Analysis",
+                ui = "tabs"
             )
-            print(plotEnrich(enriched[[db]], showTerms = 20, title = db))
-            dev.off()
-        }
+
+            # Visualize enriched terms
+            if (length(case$enrich_plots) > 0) {
+                for (db in case$dbs) {
+                    plots <- list()
+                    for (plotname in names(case$enrich_plots)) {
+                        plotargs <- extract_vars(case$enrich_plots[[plotname]], "descr", allow_nonexisting = TRUE)
+                        plotargs$data <- enrich[enrich$Database == db, , drop = FALSE]
+
+                        p <- tryCatch(
+                            do_call(VizEnrichment, plotargs),
+                            error = function(e) {
+                                stop("Failed to plot enrichment for database '", db, "' with plot '", plotname, "': ", e$message)
+                            }
+                        )
+
+                        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(
+                        list(name = db, contents = plots),
+                        hs = c(info$section, info$name),
+                        hs2 = "Enrichment Analysis",
+                        ui = "tabs"
+                    )
+                }
+            }
+            return(enrich)
+        }, error = function(e) {
+            if (case$error) {
+                stop("Error: ", e$message)
+            } else {
+                log$warn("  ! Error: {e$message}")
+                reporter$add2(
+                    list(
+                        name = "Warning",
+                        contents = list(list(kind = "error", content = e$message, kind_ = "warning"))),
+                    hs = c(info$section, info$name),
+                    hs2 = "Enrichment Analysis",
+                    ui = "tabs"
+                )
+            }
+            return(empty)
+        })
     }
 }
 
+process_allmarkers <- function(markers, object, comparison_by, plotcases, casename, groupname, subset_by_group = TRUE) {
+    name <- paste0(casename, "::", paste0(groupname, " (All Markers)"))
+    info <- case_info(name, outdir, create = TRUE)
 
-do_case <- function(casename) {
-    log_info("Dealing with case: {casename}...")
-    sec_case_names <- strsplit(casename, ":")[[1]]
-    cname <- paste(sec_case_names[-1], collapse = ":")
-    case <- cases[[casename]]
-    # ident1
-    # ident2
-    # groupby
-    # each  # expanded
-    # prefix_each
-    # dbs
-    # sigmarkers
-    # rest
-    args <- case$rest
-    args$group.by <- case$group.by
-    args$ident.1 <- case$ident.1
-    args$ident.2 <- case$ident.2
-    if (is.null(args$logfc.threshold)) {
-        args$locfc.threshold <- 0
-    }
-    if (is.null(args$min.cells.group)) {
-        args$min.cells.group <- 1
-    }
-    if (is.null(args$min.cells.feature)) {
-        args$min.cells.feature <- 1
-    }
-    if (is.null(args$min.pct)) {
-        args$min.pct <- 0
+    for (plotname in names(plotcases)) {
+        log$info("  {plotname} ...")
+        plotargs <- plotcases[[plotname]]
+        plotargs$markers <- markers
+        plotargs$object <- object
+        plotargs$comparison_by <- comparison_by
+        if (subset_by_group)
+            plotargs$subset_by <- groupname
+        plotargs$outprefix <- file.path(info$prefix, 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),
+            ui = "tabs"
+        )
     }
-    if (!is.null(case$subset)) {
-        args$object <- srtobj %>% filter(!!parse_expr(case$subset) & filter(!is.na(!!sym(case$group.by))))
-    } else {
-        args$object <- srtobj %>% filter(!is.na(!!sym(case$group.by)))
+}
+
+process_allenriches <- function(enriches, plotcases, casename, groupname) {
+    name <- paste0(casename, "::", paste0(groupname, " (All Enrichments)"))
+    info <- case_info(name, outdir, create = TRUE)
+    dbs <- unique(as.character(enriches$Database))
+
+    for (db in dbs) {
+        plots <- list()
+        for (plotname in names(plotcases)) {
+            log$info("  {plotname} ({db}) ...")
+            plotargs <- plotcases[[plotname]]
+            plotargs <- extract_vars(plotargs, "devpars")
+            plotargs$data <- enriches[enriches$Database == db, , drop = FALSE]
+            if (plotargs$plot_type == "heatmap") {
+                plotargs$group_by <- groupname
+                plotargs$show_row_names = plotargs$show_row_names %||% TRUE
+                plotargs$show_column_names = plotargs$show_column_names %||% TRUE
+            }
+
+            p <- do_call(VizEnrichment, plotargs)
+
+            if (plotargs$plot_type == "bar") {
+                attr(p, "height") <- attr(p, "height") / 1.5
+            }
+            outprefix <- file.path(info$prefix, paste0("allenrich.", slugify(db), ".", slugify(plotname)))
+            save_plot(p, outprefix, devpars, formats = "png")
+            plots[[length(plots) + 1]] <- reporter$image(outprefix, c(), FALSE)
+        }
+        reporter$add2(
+            list(name = db, contents = plots),
+            hs = c(info$section, info$name),
+            hs2 = plotname,
+            ui = "tabs"
+        )
     }
-    markers <- tryCatch({
-        do_call(FindMarkers, args) %>% rownames_to_column("gene")
-    }, error = function(e) {
-        warning(e$message, immediate. = TRUE)
-        data.frame(
-            gene = character(),
-            p_val = numeric(),
-            avg_log2FC = numeric(),
-            pct.1 = numeric(),
-            pct.2 = numeric(),
-            p_val_adj=numeric()
+}
+
+process_overlaps <- function(markers, ovcases, casename, groupname) {
+    name <- paste0(casename, "::", paste0(groupname, " (Overlaps)"))
+    info <- case_info(name, outdir, create = TRUE)
+
+    for (plotname in names(ovcases)) {
+        log$info("  {plotname} ...")
+        args <- extract_vars(
+            ovcases[[plotname]],
+            sigm = "sigmarkers", "more_formats", "save_code", "devpars", "plot_type",
+            allow_nonexisting = TRUE
         )
-    })
-    do_enrich(casename, markers, case$sigmarkers, case$volcano_genes)
-
-    siggenes <- markers %>%
-        filter(!!parse_expr(case$sigmarkers)) %>%
-        pull(gene) %>%
-        unique()
-
-    if (length(siggenes) > 0) {
-        dotplot_devpars <- case$dotplot$devpars
-        if (is.null(args$ident.2)) {
-            case$dotplot$object <- args$object
-            case$dotplot$object@meta.data <- case$dotplot$object@meta.data %>%
-                mutate(
-                    !!sym(args$group.by) := if_else(
-                        !!sym(args$group.by) == args$ident.1,
-                        args$ident.1,
-                        ".Other"
-                    ),
-                    !!sym(args$group.by) := factor(
-                        !!sym(args$group.by),
-                        levels = c(args$ident.1, ".Other")
-                    )
+
+        sigm <- sigm %||% sigmarkers
+        ugroups <- unique(markers[[groupname]])
+        m <- lapply(ugroups, function(g) {
+            markers[markers[[groupname]] == g, , drop = FALSE] %>%
+                filter(!!parse_expr(sigm)) %>%
+                pull("gene") %>% unique()
+        })
+        names(m) <- ugroups
+
+        if (plot_type == "venn") {
+            args$data <- m
+            args$in_form <- "list"
+            prefix <- file.path(info$prefix, slugify(plotname))
+            p <- do_call(gglogger::register(VennDiagram), args)
+            save_plot(p, prefix, devpars, formats = c("png", more_formats))
+            if (save_code) {
+                save_plotcode(
+                    p, prefix,
+                    c("library(plotthis)", "load('data.RData')", "invisible(list2env(args, .GlobalEnv))"),
+                    "args",
+                    auto_data_setup = FALSE
                 )
+            }
         } else {
-            case$dotplot$object <- args$object %>%
-                filter(!!sym(args$group.by) %in% c(args$ident.1, args$ident.2)) %>%
-                mutate(!!sym(args$group.by) := factor(
-                    !!sym(args$group.by),
-                    levels = c(args$ident.1, args$ident.2)
-                ))
+            args$data <- m
+            args$in_form <- "list"
+            prefix <- file.path(info$prefix, slugify(plotname))
+            p <- do_call(gglogger::register(UpsetPlot), args)
+            save_plot(p, prefix, devpars, formats = c("png", more_formats))
+            if (save_code) {
+                save_plotcode(
+                    p, prefix,
+                    c("library(plotthis)", "load('data.RData')", "invisible(list2env(args, .GlobalEnv))"),
+                    "args",
+                    auto_data_setup = FALSE
+                )
+            }
         }
-        case$dotplot$devpars <- NULL
-        case$dotplot$features <- siggenes
-        case$dotplot$group.by <- args$group.by
-        case$dotplot$assay <- case$assay
-        dotplot_width = ifelse(
-            is.null(dotplot_devpars$width),
-            if (length(siggenes) <= 20) length(siggenes) * 60 else length(siggenes) * 30,
-            dotplot_devpars$width
-        )
-        dotplot_height = ifelse(is.null(dotplot_devpars$height), 600, dotplot_devpars$height)
-        dotplot_res = ifelse(is.null(dotplot_devpars$res), 100, dotplot_devpars$res)
-        dotplot_file <- file.path(outdir, sec_case_names[1], cname, "dotplot.png")
-        png(dotplot_file, res = dotplot_res, width = dotplot_height, height = dotplot_width)
-        # rotate x axis labels
-        print(
-            do_call(DotPlot, case$dotplot) +
-            theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
-            coord_flip()
+
+        reporter$add2(
+            list(
+                name = plotname,
+                contents = list(reporter$image(prefix, more_formats, save_code))
+            ),
+            hs = c(info$section, info$name),
+            ui = "tabs"
         )
-        dev.off()
     }
+}
+
+run_case <- function(name) {
+    case <- cases[[name]]
+    log$info("Case: {name} ...")
+
+    case <- extract_vars(
+        case,
+        "dbs", "sigmarkers", "allmarker_plots", "allenrich_plots", "marker_plots", "enrich_plots",
+        "overlaps", "original_case", "markers", "enriches", "each_name", "each", "enrich_style", "original_subset",
+        subset_ = "subset",
+        allow_nonexisting = TRUE
+    )
+
+    if (!is.null(markers) || !is.null(enriches)) {
+        if (!is.null(markers)) {  # It is the overlap/allmarker case
+            log$info("- Summarizing markers in subcases (by each: {each}) ...")
+            # handle the overlaps / allmarkers analysis here
+            if (!is.data.frame(markers)) {
+                each_levels <- names(markers)
+                markers <- do_call(rbind, lapply(each_levels, function(x) {
+                    markers_df <- markers[[x]]
+                    if (nrow(markers_df) > 0) {
+                        markers_df[[each]] <- x
+                    } else {
+                        markers_df[[each]] <- character(0)  # Empty case
+                    }
+                    markers_df
+                }))
+                markers[[each]] <- factor(markers[[each]], levels = each_levels)
+            }
+            # gene, p_val, avg_log2FC, pct.1, pct.2, p_val_adj, diff_pct, <each>
+
+            if (length(allmarker_plots) > 0) {
+                log$info("- Visualizing all markers together ...")
+                if (is.null(original_subset)) {
+                    attr(markers, "object") <- srtobj
+                } else {
+                    attr(markers, "object") <- filter(srtobj, !!parse_expr(original_subset))
+                }
+                attr(markers, "group_by") <- each
+                attr(markers, "ident_1") <- NULL
+                attr(markers, "ident_2") <- NULL
+                if (!is.null(markers) && nrow(markers) > 0) {
+                    process_allmarkers(
+                        markers,
+                        object = if (is.null(original_subset)) srtobj else filter(srtobj, !!parse_expr(original_subset)),
+                        comparison_by = group_by,
+                        allmarker_plots,
+                        name,
+                        each
+                    )
+                }
+            }
+
+            if (length(overlaps) > 0) {
+                log$info("- Visualizing overlaps between subcases ...")
+                process_overlaps(markers, overlaps, name, each)
+            }
 
-    if (sec_case_names[1] %in% overlap) {
-        if (is.null(overlaps[[sec_case_names[1]]])) {
-            overlaps[[sec_case_names[1]]] <<- list()
         }
-        overlaps[[sec_case_names[1]]][[cname]] <<- siggenes
-    }
-}
 
-do_overlap <- function(section) {
-    log_info("Dealing with overlap: {section}...")
+        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)
+                enriches <- do_call(rbind, lapply(each_levels, function(x) {
+                    enrich_df <- enriches[[x]]
+                    if (nrow(enrich_df) > 0) {
+                        enrich_df[[each]] <- x
+                    } else {
+                        enrich_df[[each]] <- character(0)  # Empty case
+                    }
+                    enrich_df
+                }))
+                enriches[[each]] <- factor(enriches[[each]], levels = each_levels)
+            }
 
-    ov_dir <- file.path(outdir, "OVERLAPS", section)
-    dir.create(ov_dir, showWarnings = FALSE, recursive = TRUE)
+            if (length(allenrich_plots) > 0 && !is.null(enriches) && nrow(enriches) > 0) {
+                log$info("- Visualizing all enrichments together ...")
+                # add other metadata columns if any by mapping groupname
+                # only add the metadata columns from object if there is a single value mapped
+                metacols <- srtobj@meta.data %>% group_by(!!sym(each)) %>%
+                    summarize(across(everything(), ~ n_distinct(.) == 1), .groups = "keep") %>%
+                    select(where(~ all(. == TRUE))) %>%
+                    colnames()
 
-    ov_cases <- overlaps[[section]]
-    if (length(ov_cases) < 2) {
-        stop(sprintf("  Not enough cases for overlap: %s", section))
-    }
+                if (length(metacols) > 1) {
+                    metadf <- srtobj@meta.data[, metacols, drop = FALSE]  %>%
+                        distinct(!!sym(each), .keep_all = TRUE)
+
+                    for (col in setdiff(metacols, each)) {
+                        if (col %in% colnames(enriches)) {
+                            warning("Column name conflict: {col}, adding with suffix '_meta'", immediate. = TRUE)
+                            metadf[[paste0(col, "_meta")]] <- metadf[[col]]
+                            metadf[[col]] <- NULL
+                        }
+                    }
+
+                    enriches <- left_join(enriches, metadf, by = each)
+                }
+
+                process_allenriches(enriches, allenrich_plots, name, each)
+            }
+        }
 
-    if (length(ov_cases) <= 4) {
-        venn_plot <- file.path(ov_dir, "venn.png")
-        venn_p <- ggVennDiagram(ov_cases, label_percent_digit = 1) +
-            scale_fill_distiller(palette = "Reds", direction = 1) +
-            scale_x_continuous(expand = expansion(mult = .2))
-        png(venn_plot, res = 100, width = 1000, height = 600)
-        print(venn_p)
-        dev.off()
+        return(invisible())
     }
 
-    df_markers <- fromList(ov_cases)
-    #  A  B  MARKERS
-    #  1  0  G1
-    #  1  0  G2
-    #  0  1  G3
-    #  0  1  G4
-    #  1  1  G5
-    df_markers$MARKERS = Reduce(union, ov_cases)
-    df_markers = df_markers %>%
-        group_by(across(-MARKERS)) %>%
-        summarise(MARKERS = paste0(MARKERS, collapse = ","), .groups = "drop")
-
-    write.table(
-        df_markers,
-        file.path(ov_dir, "markers.txt"),
-        sep = "\t",
-        row.names = FALSE,
-        col.names = TRUE,
-        quote = FALSE
-    )
+    # Let RunSeuratDEAnalysis handle the subset
+    case$subset <- subset_
+    case$object <- srtobj
+    markers <- do_call(RunSeuratDEAnalysis, case)
+    case$object <- NULL  # Release memory
+    gc()
+
+    subobj <- if (is.null(subset_)) srtobj else filter(srtobj, !!parse_expr(subset_))
+
+    if (is.null(case$ident_1)) {
+        all_idents <- unique(as.character(markers[[case$group_by]]))
+        enriches <- list()
+        for (ident in all_idents) {
+            log$info("- {case$group_by}: {ident} ...")
+            ident_markers <- markers[markers[[case$group_by]] == ident, , drop = TRUE]
+            casename <- paste0(name, "::", paste0(case$group_by, ": ", ident))
+            info <- case_info(casename, outdir, create = TRUE)
+
+            attr(ident_markers, "ident_1") <- ident
+            enrich <- process_markers(ident_markers, info = info, case = list(
+                object = subobj,
+                dbs = dbs,
+                group_by = case$group_by,
+                sigmarkers = sigmarkers,
+                enrich_style = enrich_style,
+                marker_plots = marker_plots,
+                enrich_plots = enrich_plots,
+                error = case$error,
+                ident = NULL
+            ))
+            enriches[[ident]] <- enrich
+        }
 
-    upset_plot <- file.path(ov_dir, "upset.png")
-    upset_p <- upset(fromList(ov_cases))
-    png(upset_plot, res = 100, width = 800, height = 600)
-    print(upset_p)
-    dev.off()
+        if (length(allmarker_plots) > 0) {
+            log$info("- Visualizing all markers together ...")
+            process_allmarkers(
+                markers,
+                object = subobj,
+                comparison_by = case$group_by,
+                plotcases = allmarker_plots,
+                casename = name,
+                groupname = case$group_by,
+                subset_by_group = FALSE)
+        }
+
+        if (length(overlaps) > 0) {
+            log$info("- Visualizing overlaps between subcases ...")
+            process_overlaps(markers, overlaps, name, case$group_by)
+        }
+
+        if (length(allenrich_plots) > 0) {
+            log$info("- Visualizing all enrichments together ...")
+            # add other metadata columns if any by mapping groupname
+            # only add the metadata columns from object if there is a single value mapped
+            metacols <- subobj@meta.data %>% group_by(!!sym(case$group_by)) %>%
+                summarize(across(everything(), ~ n_distinct(.) == 1), .groups = "keep") %>%
+                select(where(~ all(. == TRUE))) %>%
+                colnames()
+
+            if (length(metacols) > 1) {
+                metadf <- subobj@meta.data[, metacols, drop = FALSE]  %>%
+                    distinct(!!sym(case$group_by), .keep_all = TRUE)
+
+                for (col in setdiff(metacols, case$group_by)) {
+                    if (col %in% colnames(enriches[[1]])) {
+                        warning("Column name conflict: {col}, adding with suffix '_meta'", immediate. = TRUE)
+                        metadf[[paste0(col, "_meta")]] <- metadf[[col]]
+                        metadf[[col]] <- NULL
+                    }
+                }
+
+                for (ne in names(enriches)) {
+                    if (!case$group_by %in% colnames(enriches[[ne]])) {
+                        enriches[[ne]][[case$group_by]] <- ne
+                    }
+                    enriches[[ne]] <- left_join(enriches[[ne]], metadf, by = case$group_by)
+                }
+            }
+            enriches <- do_call(rbind, enriches)
+            process_allenriches(enriches, allenrich_plots, name, case$group_by)
+        }
+    } else {
+        info <- case_info(name, outdir, create = TRUE)
+        enrich <- process_markers(markers, info = info, case = list(
+            object = subobj,
+            dbs = dbs,
+            group_by = case$group_by,
+            sigmarkers = sigmarkers,
+            enrich_style = enrich_style,
+            marker_plots = marker_plots,
+            enrich_plots = enrich_plots,
+            error = case$error,
+            ident = if (is.null(case$ident_2)) case$ident_1 else paste0(case$ident_1, " vs ", case$ident_2)
+        ))
+
+        if (!is.null(original_case) && !is.null(cases[[original_case]])) {
+            if (nrow(markers) > 0) {
+                markers[[each_name]] <- each
+            }
+            cases[[original_case]]$markers[[each]] <<- markers
+            cases[[original_case]]$enriches[[each]] <<- enrich
+        }
+    }
+
+    invisible()
 }
 
-sapply(sort(names(cases)), do_case)
-sapply(sort(names(overlaps)), do_overlap)
+sapply(names(cases), run_case)
+
+reporter$save(joboutdir)