biopipen 0.34.0__tar.gz → 0.34.1__tar.gz

{biopipen-0.34.0 → biopipen-0.34.1}/PKG-INFO

@@ -1,6 +1,6 @@
 Metadata-Version: 2.3
 Name: biopipen
-Version: 0.34.0
+Version: 0.34.1
 Summary: Bioinformatics processes/pipelines that can be run from `pipen run`
 License: MIT
 Author: pwwang

biopipen-0.34.1/biopipen/__init__.py

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

{biopipen-0.34.0 → biopipen-0.34.1}/biopipen/ns/scrna.py

@@ -61,7 +61,8 @@ class SeuratPreparing(Proc):
     Those paths should be either paths to directoies containing `matrix.mtx`,
     `barcodes.tsv` and `features.tsv` files that can be loaded by
     [`Seurat::Read10X()`](https://satijalab.org/seurat/reference/read10x),
-    or paths to `h5` files that can be loaded by
+    or paths of loom files that can be loaded by `SeuratDisk::LoadLoom()`, or paths to
+    `h5` files that can be loaded by
     [`Seurat::Read10X_h5()`](https://satijalab.org/seurat/reference/read10x_h5).
 
     Each sample will be loaded individually and then merged into one `Seurat` object, and then perform QC.
@@ -110,9 +111,11 @@ class SeuratPreparing(Proc):
         min_cells (type=int): The minimum number of cells that a gene must be
             expressed in to be kept. This is used in `Seurat::CreateSeuratObject()`.
             Futher QC (`envs.cell_qc`, `envs.gene_qc`) will be performed after this.
+            It doesn't work when data is loaded from loom files.
         min_features (type=int): The minimum number of features that a cell must
             express to be kept. This is used in `Seurat::CreateSeuratObject()`.
             Futher QC (`envs.cell_qc`, `envs.gene_qc`) will be performed after this.
+            It doesn't work when data is loaded from loom files.
         cell_qc: Filter expression to filter cells, using
             `tidyrseurat::filter()`.
             Available QC keys include `nFeature_RNA`, `nCount_RNA`,
@@ -587,9 +590,11 @@ class SeuratClusterStats(Proc):
         ngenes (type=json): The number of genes expressed in each cell.
             Keys are the names of the plots and values are the dicts inherited from `env.ngenes_defaults`.
         features_defaults (ns): The default parameters for `features`.
-            - features: The features to plot.
+            - features (type=auto): The features to plot.
                 It can be either a string with comma separated features, a list of features, a file path with `file://` prefix with features
                 (one per line), or an integer to use the top N features from `VariantFeatures(srtobj)`.
+                It can also be a dict with the keys as the feature group names and the values as the features, which
+                is used for heatmap to group the features.
             - order_by (type=auto): The order of the clusters to show on the plot.
                 An expression passed to `dplyr::arrange()` on the grouped meta data frame (by `ident`).
                 For example, you can order the clusters by the activation score of
@@ -1082,6 +1087,16 @@ class MarkersFinder(Proc):
             - <more>: Other arguments passed to [`scplotter::FeatureStatPlot()`](https://pwwang.github.io/scplotter/reference/FeatureStatPlot.html).
         allmarker_plots (type=json): All marker plot cases.
             The keys are the names of the cases and the values are the dicts inherited from `allmarker_plots_defaults`.
+        allenrich_plots_defaults (ns): Default options for the plots to generate for the enrichment analysis.
+            - plot_type: The type of the plot.
+            - devpars (ns): The device parameters for the plots.
+                - 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.html>.
+        allenrich_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 `allenrich_plots_defaults`.
+            The cases under `envs.cases` can inherit this options.
         marker_plots_defaults (ns): Default options for the plots to generate for the markers.
             - plot_type: The type of the plot.
                 See <https://pwwang.github.io/scplotter/reference/FeatureStatPlot.html>.
@@ -1170,6 +1185,11 @@ class MarkersFinder(Proc):
             "genes": 10,
         },
         "allmarker_plots": {},
+        "allenrich_plots_defaults": {
+            "plot_type": "heatmap",
+            "devpars": {"res": 100},
+        },
+        "allenrich_plots": {},
         "marker_plots_defaults": {
             "plot_type": None,
             "more_formats": [],
@@ -1617,6 +1637,15 @@ class ScFGSEA(Proc):
             If it is < 1, will apply it to `padj`, selecting pathways with `padj` < `top`.
         eps (type=float): This parameter sets the boundary for calculating the p value.
             See <https://rdrr.io/bioc/fgsea/man/fgseaMultilevel.html>
+        allpathway_plots_defaults (ns): Default options for the plots to generate for all pathways.
+            - plot_type: The type of the plot, currently either dot or heatmap (default)
+            - devpars (ns): The device parameters for the plots.
+                - 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/biopipen.utils.R/reference/VizGSEA.html>.
+        allpathway_plots (type=json): Cases of the plots to generate for all pathways.
+            The keys are the names of the cases and the values are the dicts inherited from `allpathway_plots_defaults`.
         minsize (type=int): Minimal size of a gene set to test. All pathways below the threshold are excluded.
         maxsize (type=int): Maximal size of a gene set to test. All pathways above the threshold are excluded.
         rest (type=json;order=98): Rest arguments for [`fgsea()`](https://rdrr.io/bioc/fgsea/man/fgsea.html)
@@ -1644,18 +1673,23 @@ class ScFGSEA(Proc):
         "ident-2": None,
         "each": None,
         "subset": None,
-        "gmtfile": "",
+        "gmtfile": "KEGG_2021_Human",
         "method": "s2n",
         "top": 20,
         "minsize": 10,
         "maxsize": 100,
         "eps": 0,
+        "allpathway_plots_defaults": {
+            "plot_type": "heatmap",
+            "devpars": {"res": 100},
+        },
+        "allpathway_plots": {},
         "rest": {},
         "cases": {},
     }
     script = "file://../scripts/scrna/ScFGSEA.R"
     plugin_opts = {
-        "report": "file://../reports/scrna/ScFGSEA.svelte",
+        "report": "file://../reports/common.svelte",
         "report_paging": 8,
     }
 

{biopipen-0.34.0 → biopipen-0.34.1}/biopipen/scripts/scrna/MarkersFinder.R

@@ -27,6 +27,8 @@ cache <- {{ envs.cache | r }}
 rest <- {{ envs.rest | r: todot="-" }}
 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 }}
@@ -59,6 +61,9 @@ if (!is.null(mutaters) && length(mutaters) > 0) {
 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)
 })
@@ -82,6 +87,8 @@ defaults <- list(
     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,
@@ -107,6 +114,9 @@ post_casing <- function(name, case) {
         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,
@@ -114,6 +124,12 @@ post_casing <- function(name, case) {
         )
         case$allmarker_plots_defaults <- NULL
 
+        case$allenrich_plots <- lapply(
+            case$allenrich_plots,
+            function(x) { list_update(case$allenrich_plots_defaults, x) }
+        )
+        case$allenrich_plots_defaults <- NULL
+
         case$marker_plots <- lapply(
             case$marker_plots,
             function(x) { list_update(case$marker_plots_defaults, x) }
@@ -179,20 +195,31 @@ post_casing <- function(name, case) {
             # 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
         }
 
-        if (length(case$overlaps) > 0 || length(case$allmarker_plots) > 0) {
+        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
+
+            ovcase$enriches <- list()
+            ovcase$allenrich_plots <- lapply(
+                ovcase$allenrich_plots,
+                function(x) { list_update(ovcase$allenrich_plots_defaults, x) }
+            )
+            ovcase$allenrich_plots_defaults <- NULL
+
             ovcase$overlaps <- lapply(
                 ovcase$overlaps,
                 function(x) { list_update(ovcase$overlaps_defaults, x) }
@@ -255,6 +282,32 @@ process_markers <- function(markers, info, case) {
 
     # 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) {
@@ -271,6 +324,7 @@ process_markers <- function(markers, info, case) {
                 ui = "tabs"
             )
         }
+        return(empty)
     } else {
         tryCatch({
             enrich <- RunEnrichment(
@@ -298,7 +352,9 @@ process_markers <- function(markers, info, case) {
 
                         p <- do_call(VizEnrichment, plotargs)
 
-                        attr(p, "height") <- attr(p, "height") / 1.5
+                        if (plotargs$plot_type == "bar") {
+                            attr(p, "height") <- attr(p, "height") / 1.5
+                        }
                         outprefix <- file.path(info$prefix, paste0("enrich.", slugify(db), ".", slugify(plotname)))
                         save_plot(p, outprefix, plotargs$devpars, formats = "png")
                         plots[[length(plots) + 1]] <- reporter$image(outprefix, c(), FALSE)
@@ -311,6 +367,7 @@ process_markers <- function(markers, info, case) {
                     )
                 }
             }
+            return(enrich)
         }, error = function(e) {
             if (case$error) {
                 stop("Error: ", e$message)
@@ -325,6 +382,7 @@ process_markers <- function(markers, info, case) {
                     ui = "tabs"
                 )
             }
+            return(empty)
         })
     }
 }
@@ -332,6 +390,7 @@ process_markers <- function(markers, info, case) {
 process_allmarkers <- function(markers, plotcases, casename, groupname) {
     name <- paste0(casename, "::", paste0(groupname, " (All Markers)"))
     info <- case_info(name, outdir, create = TRUE)
+
     for (plotname in names(plotcases)) {
         plotargs <- plotcases[[plotname]]
         plotargs$degs <- markers
@@ -348,6 +407,41 @@ process_allmarkers <- function(markers, plotcases, casename, groupname) {
     }
 }
 
+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)) {
+            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"
+        )
+    }
+}
+
 process_overlaps <- function(markers, ovcases, casename, groupname) {
     name <- paste0(casename, "::", paste0(groupname, ": Overlaps"))
     info <- case_info(name, outdir, create = TRUE)
@@ -415,38 +509,71 @@ run_case <- function(name) {
 
     case <- extract_vars(
         case,
-        "dbs", "sigmarkers", "allmarker_plots", "marker_plots", "enrich_plots", "overlaps",
-        "original_case", "markers", "each_name", "each", "enrich_style",
+        "dbs", "sigmarkers", "allmarker_plots", "allenrich_plots", "marker_plots", "enrich_plots",
+        "overlaps", "original_case", "markers", "enriches", "each_name", "each", "enrich_style",
         allow_nonexisting = TRUE
     )
-    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)) {
-            markers <- do_call(rbind, lapply(names(markers), function(x) {
-                markers_df <- markers[[x]]
-                markers_df[[each]] <- x
-                markers_df
-            }))
-        }
-        # 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 ...")
-            attr(markers, "object") <- srtobj
-            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) || !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 ...")
+                attr(markers, "object") <- srtobj
+                attr(markers, "group.by") <- each
+                attr(markers, "ident.1") <- NULL
+                attr(markers, "ident.2") <- NULL
+                process_allmarkers(markers, allmarker_plots, name, each)
+            }
+
+            if (length(overlaps) > 0) {
+                log$info("- Visualizing overlaps between subcases ...")
+                process_overlaps(markers, overlaps, name, each)
+            }
+
         }
 
-        if (length(overlaps) > 0) {
-            log$info("- Visualizing overlaps between subcases ...")
-            process_overlaps(markers, overlaps, name, each)
+        if (!is.null(enriches)) {
+            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)
+            }
+
+            if (length(allenrich_plots) > 0) {
+                log$info("- Visualizing all enrichments together ...")
+                process_allenriches(enriches, allenrich_plots, name, each)
+            }
         }
 
         return(invisible())
     }
+
     case$object <- srtobj
     markers <- do_call(RunSeuratDEAnalysis, case)
     case$object <- NULL
@@ -454,6 +581,7 @@ run_case <- function(name) {
 
     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]
@@ -461,7 +589,7 @@ run_case <- function(name) {
             info <- case_info(casename, outdir, create = TRUE)
 
             attr(ident_markers, "ident.1") <- ident
-            process_markers(ident_markers, info = info, case = list(
+            enrich <- process_markers(ident_markers, info = info, case = list(
                 dbs = dbs,
                 sigmarkers = sigmarkers,
                 enrich_style = enrich_style,
@@ -470,6 +598,7 @@ run_case <- function(name) {
                 error = case$error,
                 ident = NULL
             ))
+            enriches[[ident]] <- enrich
         }
 
         if (length(allmarker_plots) > 0) {
@@ -481,9 +610,14 @@ run_case <- function(name) {
             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 ...")
+            process_allenriches(enriches, allenrich_plots, name, case$group.by)
+        }
     } else {
         info <- case_info(name, outdir, create = TRUE)
-        process_markers(markers, info = info, case = list(
+        enrich <- process_markers(markers, info = info, case = list(
             dbs = dbs,
             sigmarkers = sigmarkers,
             enrich_style = enrich_style,
@@ -493,9 +627,10 @@ run_case <- function(name) {
             ident = if (is.null(case$ident.2)) case$ident.1 else paste0(case$ident.1, " vs ", case$ident.2)
         ))
 
-        if (!is.null(original_case)) {
+        if (!is.null(original_case) && !is.null(cases[[original_case]])) {
             markers[[each_name]] <- each
             cases[[original_case]]$markers[[each]] <<- markers
+            cases[[original_case]]$enriches[[each]] <<- enrich
         }
     }
 

{biopipen-0.34.0 → biopipen-0.34.1}/biopipen/scripts/scrna/ScFGSEA.R

@@ -18,6 +18,8 @@ top <- {{envs.top | r}}  # nolint
 minsize <- {{envs.minSize | default: envs.minsize | r}}  # nolint
 maxsize <- {{envs.maxSize | default: envs.maxsize | r}}  # nolint
 eps <- {{envs.eps | r}}  # nolint
+allpathway_plots_defaults <- {{envs.allpathway_plots_defaults | r}}  # nolint
+allpathway_plots <- {{envs.allpathway_plots | r}}  #
 ncores <- {{envs.ncores | r}}  # nolint
 rest <- {{envs.rest | r: todot="-"}}  # nolint
 cases <- {{envs.cases | r: todot="-"}}  # nolint
@@ -25,6 +27,10 @@ cases <- {{envs.cases | r: todot="-"}}  # nolint
 log <- get_logger()
 reporter <- get_reporter()
 
+allpathway_plots <- lapply(allpathway_plots, function(x) {
+    list_update(allpathway_plots_defaults, x)
+})
+
 log$info("Reading Seurat object ...")
 srtobj <- read_obj(srtfile)
 if (!"Identity" %in% colnames(srtobj@meta.data)) {
@@ -48,6 +54,8 @@ defaults <- list(
     minsize = minsize,
     maxsize = maxsize,
     eps = eps,
+    allpathway_plots_defaults = allpathway_plots_defaults,
+    allpathway_plots = allpathway_plots,
     ncores = ncores,
     rest = rest
 )
@@ -58,6 +66,10 @@ expand_each <- function(name, case) {
     case$group.by <- case$group.by %||% "Identity"
 
     if (is.null(case$each) || is.na(case$each) || nchar(case$each) == 0 || isFALSE(each)) {
+        if (length(case$allpathway_plots) > 0) {
+            stop("Cannot perform `allpathway_plots` without `each` defined.")
+        }
+
         outcases[[name]] <- case
     } else {
         eachs <- if (!is.null(case$subset)) {
@@ -77,10 +89,13 @@ expand_each <- function(name, case) {
             newname <- paste0(case$each, "::", each)
             newcase <- case
 
-            newcase$original_case <- name
+            newcase$original_case <- paste0(name, " (all ", case$each,")")
             newcase$each_name <- case$each
             newcase$each <- each
 
+            newcase$allpathway_plots_defaults <- NULL
+            newcase$allpathway_plots <- NULL
+
             if (!is.null(case$subset)) {
                 newcase$subset <- paste0(case$subset, " & ", bQuote(case$each), " == '", each, "'")
             } else {
@@ -89,6 +104,18 @@ expand_each <- function(name, case) {
 
             outcases[[newname]] <- newcase
         }
+
+        if (length(case$allpathway_plots) > 0) {
+            newcase <- case
+
+            newcase$gseas <- list()
+            newcase$allpathway_plots <- lapply(
+                newcase$allpathway_plots,
+                function(x) { list_update(newcase$allpathway_plots_defaults, x) }
+            )
+
+            outcases[[paste0(name, " (all ", case$each,")")]] <- newcase
+        }
     }
     outcases
 }
@@ -108,12 +135,50 @@ ensure_sobj <- function(expr, allow_empty) {
     })
 }
 
-
 do_case <- function(name) {
     log$info("- Processing case: {name} ...")
     case <- cases[[name]]
     info <- case_info(name, outdir, create = TRUE)
 
+    if (!is.null(case$gseas)) {
+
+        each_levels <- names(case$gseas)
+        gseas <- do_call(rbind, lapply(each_levels, function(x) {
+            gsea_df <- case$gseas[[x]]
+            if (nrow(gsea_df) > 0) {
+                gsea_df[[case$each]] <- x
+            } else {
+                gsea_df[[case$each]] <- character(0)  # Empty case
+            }
+            gsea_df
+        }))
+        gseas[[case$each]] <- factor(gseas[[case$each]], levels = each_levels)
+
+        for (plotname in names(case$allpathway_plots)) {
+            plotargs <- case$allpathway_plots[[plotname]]
+            plotargs <- extract_vars(plotargs, "devpars")
+            plotargs$gsea_results <- gseas
+            plotargs$group_by <- case$each
+            if (plotargs$plot_type == "heatmap") {
+                plotargs$show_row_names <- plotargs$show_row_names %||% TRUE
+                plotargs$show_column_names <- plotargs$show_column_names %||% TRUE
+            }
+
+            p <- do_call(VizGSEA, plotargs)
+
+            outprefix <- file.path(info$prefix, paste0("all.", slugify(plotname)))
+            save_plot(p, outprefix, devpars, formats = "png")
+            reporter$add2(
+                list(kind = "descr", content = paste0("Pathways for all ", case$each, ".")),
+                list(kind = "image", src = paste0(outprefix, ".png")),
+                hs = c(info$section, info$name),
+                hs2 = plotname
+            )
+        }
+
+        return(invisible(NULL))
+    }
+
     allow_empty = !is.null(case$each)
     # prepare expression matrix
     log$info("  Preparing expression matrix...")
@@ -167,9 +232,9 @@ do_case <- function(name) {
     log$info("  Getting preranks...")
     ranks <- RunGSEAPreRank(exprs, allclasses, case$ident.1, case$ident.2, case$method)
     write.table(
-        ranks,
-        file.path(info$prefix, "fgsea.rank"),
-        row.names = FALSE,
+        as.data.frame(ranks),
+        file.path(info$prefix, "fgsea.rank.txt"),
+        row.names = TRUE,
         col.names = TRUE,
         sep = "\t",
         quote = FALSE
@@ -216,15 +281,17 @@ do_case <- function(name) {
         quote = FALSE
     )
 
+    aspect.ratio <- sqrt(case$top) / sqrt(10)
     p_summary <- VizGSEA(
         result,
         plot_type = "summary",
-        top_term = case$top
+        top_term = case$top,
+        aspect.ratio = aspect.ratio
     )
     save_plot(
         p_summary,
         file.path(info$prefix, "summary"),
-        devpars = list(res = 100, height = attr(p_summary, "height") * 100, width = attr(p_summary, "width") * 100),
+        devpars = list(res = 100, height = attr(p_summary, "height") * 100 / 1.5, width = attr(p_summary, "width") * 100),
         formats = "png"
     )
 
@@ -243,13 +310,13 @@ do_case <- function(name) {
 
     reporter$add2(
         list(
-            name = "Table",
+            name = paste0("Table (", case$ident.1, " vs ", case$ident.2, ")"),
             contents = list(
                 list(kind = "descr", content = paste0(
                     "Showing top 50 pathways by padj in descending order. ",
                     "Use 'Download the entire data' button to download all pathways."
                 )),
-                list(kind = "table", src = file.path(info$prefix, "fgsea"), data = list(nrows = 50))
+                list(kind = "table", src = file.path(info$prefix, "fgsea.tsv"), data = list(nrows = 50))
             )
         ),
         list(
@@ -269,8 +336,14 @@ do_case <- function(name) {
         hs = c(info$section, info$name),
         ui = "tabs"
     )
+
+    if (!is.null(case$original_case) && !is.null(cases[[case$original_case]])) {
+        cases[[case$original_case]]$gseas[[case$each]] <<- result
+    }
+
+    invisible()
 }
 
-sapply(sort(names(cases)), function(name) do_case(name))
+sapply(names(cases), function(name) do_case(name))
 
 reporter$save(joboutdir)

{biopipen-0.34.0 → biopipen-0.34.1}/biopipen/scripts/scrna/SeuratClusterStats-features.R

@@ -53,6 +53,10 @@ hvf <- NULL
         }
     }
 
+    if (is.list(features)) {
+        return(lapply(features, function(x) {.get_features(x, object) }))
+    }
+
     return (trimws(unlist(strsplit(features, ","))))
 }
 

{biopipen-0.34.0 → biopipen-0.34.1}/biopipen/scripts/scrna/TopExpressingGenes.R

@@ -144,7 +144,9 @@ process_markers <- function(markers, info, case) {
                 p <- do_call(VizEnrichment, plotargs)
 
                 outprefix <- file.path(info$prefix, paste0("enrich.", slugify(db), ".", slugify(plotname)))
-                attr(p, "height") <- attr(p, "height") / 1.5
+                if (plotargs$plot_type == "bar") {
+                    attr(p, "height") <- attr(p, "height") / 1.5
+                }
                 save_plot(p, outprefix, plotargs$devpars, formats = "png")
                 plots[[length(plots) + 1]] <- reporter$image(outprefix, c(), FALSE)
             }