biopipen 0.33.1__py3-none-any.whl → 0.34.0__py3-none-any.whl

biopipen/scripts/scrna/TopExpressingGenes.R

@@ -1,13 +1,8 @@
-{{ biopipen_dir | joinpaths: "utils", "misc.R" | source_r }}
-
 library(Seurat)
-library(tibble)
-library(enrichR)
 library(rlang)
 library(dplyr)
-library(ggprism)
-
-setEnrichrSite("Enrichr")
+library(tidyselect)
+library(biopipen.utils)
 
 srtfile <- {{in.srtobj | r}}
 outdir <- {{out.outdir | r}}
@@ -16,238 +11,200 @@ mutaters <- {{ envs.mutaters | r }}
 ident <- {{ envs.ident | r }}
 group.by <- {{ envs["group-by"] | r }}  # nolint
 each <- {{ envs.each | r }}
-prefix_each <- {{ envs.prefix_each | r }}
-section <- {{ envs.section | r }}
 dbs <- {{ envs.dbs | r }}
 n <- {{ envs.n | r }}
+enrich_style <- {{ envs.enrich_style | r }}
 sset <- {{ envs.subset | r }}
+enrich_plots_defaults <- {{ envs.enrich_plots_defaults | r }}
+enrich_plots <- {{ envs.enrich_plots | r }}
 cases <- {{ envs.cases | r: todot = "-" }}  # nolint
 
 set.seed(8525)
+log <- get_logger()
+reporter <- get_reporter()
 
-log_info("- Loading Seurat object ...")
-srtobj <- readRDS(srtfile)
+log$info("Reading Seurat object ...")
+srtobj <- read_obj(srtfile)
+if (!"Identity" %in% colnames(srtobj@meta.data)) {
+    srtobj@meta.data$Identity <- Idents(srtobj)
+}
 assay <- DefaultAssay(srtobj)
 
-log_info("- Mutate meta data if needed ...")
-if (!is.null(mutaters) && length(mutaters)) {
+if (!is.null(mutaters) && length(mutaters) > 0) {
+    log$info("Mutating meta data ...")
     srtobj@meta.data <- srtobj@meta.data %>%
         mutate(!!!lapply(mutaters, parse_expr))
 }
 
+enrich_plots <- lapply(enrich_plots, function(x) {
+    list_update(enrich_plots_defaults, x)
+})
 defaults <- list(
     ident = ident,
     group.by = group.by,
     each = each,
-    prefix_each = prefix_each,
-    section = section,
     dbs = dbs,
     n = n,
+    enrich_style = enrich_style,
+    enrich_plots = enrich_plots,
+    enrich_plots_defaults = enrich_plots_defaults,
     subset = sset
 )
 
-expand_each <- function(name, case) {
+cases <- expand_cases(cases, defaults, default_case = "Top Expressing Genes", post = function(name, case) {
     outcases <- list()
-    no_each <- is.null(case$each) || nchar(case$each) == 0
-    no_ident <- is.null(case$ident)
-    has_section <- !is.null(case$section) && case$section != "DEFAULT"
-    if (no_each && !no_ident) {
-        # single cases
-        if (is.null(case$section) || case$section == "DEFAULT") {
-            outcases[[name]] <- case
-        } else {
-            outcases[[paste0(case$section, "::", name)]] <- case
-        }
-    } else if (no_each) {  # no_ident
-        # expanding idents
-        if (has_section) {
-            log_warn("  Ignoring `section` in case `{name}` when no `ident` is set.")
-            case$section <- NULL
-        }
-        if (!is.null(case$subset)) {
-            idents <- srtobj@meta.data %>% filter(!!parse_expr(case$subset)) %>%
-                pull(case$group.by) %>% unique() %>% na.omit() %>% as.vector()
-        } else {
-            idents <- srtobj@meta.data %>%
-                pull(case$group.by) %>% unique() %>% na.omit() %>% as.vector()
-        }
+    if (is.null(case$each) || is.na(case$each) || nchar(case$each) == 0 || isFALSE(each)) {
+        case$enrich_plots <- lapply(
+            case$enrich_plots,
+            function(x) { list_update(case$enrich_plots_defaults, x) }
+        )
+        case$enrich_plots_defaults <- NULL
 
-        for (ident in idents) {
-            key <- paste0(name, "::", ident)
-            outcases[[key]] <- case
-            outcases[[key]]$ident <- ident
-            outcases[[key]]$section <- name
-        }
-    } else {  # has_each
-        if (no_ident) {
-            stop("  `ident` must be set when `each` is set for case `{name}`.")
-        }
-        # expanding eachs
-        if (has_section) {
-            log_warn("  Ignoring `section` in case `{name}` when `each` is set.")
-            case$section <- NULL
+        outcases[[name]] <- case
+    } else {
+        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()
         }
 
-        if (!is.null(case$subset)) {
-            eachs <- srtobj@meta.data %>% filter(!!parse_expr(case$subset)) %>%
-                pull(case$each) %>% unique() %>% na.omit() %>% as.vector()
-        } else {
-            eachs <- srtobj@meta.data %>%
-                pull(case$each) %>% unique() %>% na.omit() %>% as.vector()
+        if (length(cases) == 0 && name == "Top Expressing Genes") {
+            name <- case$each
         }
 
         for (each in eachs) {
-            by <- make.names(paste0(".", name, "_", case$each,"_", each))
-            srtobj@meta.data <<- srtobj@meta.data %>% mutate(
-                !!sym(by) := if_else(
-                    !!sym(case$each) == each,
-                    !!sym(case$group.by),
-                    NA
-                )
-            )
+            newname <- paste0(name, " - ", each)
+            newcase <- case
+            newcase$each_name <- case$each
+            newcase$each <- each
 
-            if (isTRUE(case$prefix_each)) {
-                key <- paste0(name, "::", case$each, " - ", each)
+            if (!is.null(case$subset)) {
+                newcase$subset <- paste0(case$subset, " & ", bQuote(case$each), " == '", each, "'")
             } else {
-                key <- paste0(name, "::", each)
+                newcase$subset <- paste0(bQuote(case$each), " == '", each, "'")
             }
-            outcases[[key]] <- case
-            outcases[[key]]$section <- name
-            outcases[[key]]$group.by <- by
+
+            newcase$enrich_plots <- lapply(
+                case$enrich_plots,
+                function(x) { list_update(case$enrich_plots_defaults, x) }
+            )
+            newcase$enrich_plots_defaults <- NULL
+
+            outcases[[newname]] <- newcase
         }
     }
-    outcases
-}
 
-log_info("- Expanding cases ...")
-cases <- expand_cases(cases, defaults, expand_each)
-
-do_enrich <- function(expr, odir) {
-    log_debug("  Saving expressions ...")
-    expr <- expr %>% as.data.frame()
-    colnames(expr) <- c("Expression")
-    expr <- expr %>% rownames_to_column("Gene") %>% select(Gene, Expression)
-    write.table(
-        expr,
-        file.path(odir, "expr.txt"),
-        sep = "\t",
-        row.names = TRUE,
-        col.names = TRUE,
-        quote = FALSE
+    outcases
+})
+
+log$info("Running cases ...")
+
+process_markers <- function(markers, info, case) {
+    # Save markers
+    write.table(markers, file.path(info$prefix, "top_genes.tsv"), sep = "\t", quote = FALSE, row.names = FALSE)
+    reporter$add2(
+        list(
+            name = "Table",
+            contents = list(
+                list(kind = "descr", content = "Showing top expressing genes ordered by their expression descendingly."),
+                list(kind = "table", src = file.path(info$prefix, "top_genes.tsv"), data = list(nrows = 100))
+            )
+        ),
+        hs = c(info$section, info$name),
+        hs2 = paste0("Top Genes"),
+        ui = "tabs"
     )
-    write.table(
-        expr %>% head(n),
-        file.path(odir, "exprn.txt"),
-        sep = "\t",
-        row.names = TRUE,
-        col.names = TRUE,
-        quote = FALSE
+
+    enrich <- RunEnrichment(
+        markers$gene,
+        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"
     )
 
-    log_debug("  Running enrichment ...")
-    enriched <- enrichr(head(expr$Gene, n), dbs)  # nolint
-    for (db in dbs) {
-        write.table(
-            enriched[[db]],
-            file.path(odir, paste0("Enrichr-", db, ".txt")),
-            sep = "\t",
-            row.names = FALSE,
-            col.names = TRUE,
-            quote = FALSE
-        )
+    # Visualize enriched terms
+    if (length(case$enrich_plots) > 0) {
+        for (db in case$dbs) {
+            plots <- list()
+            for (plotname in names(case$enrich_plots)) {
+                plotargs <- case$enrich_plots[[plotname]]
+                plotargs$data <- enrich[enrich$Database == db, , drop = FALSE]
 
-        if (nrow(enriched[[db]]) == 0) {
-            log_warn(paste0("  No enriched terms for ", db))
-            next
-        }
+                p <- do_call(VizEnrichment, plotargs)
 
-        enrich_p <- plotEnrich(enriched[[db]], showTerms = 20, title = db) +
-            theme_prism()
-        enrich_plot <- file.path(odir, paste0("Enrichr-", db, ".png"))
-        png(enrich_plot, res = 100, height = 1000, width = 1000)
-        print(enrich_p)
-        dev.off()
-
-        enrich_plot_pdf <- file.path(odir, paste0("Enrichr-", db, ".pdf"))
-        pdf(enrich_plot_pdf, height = 10, width = 10)
-        print(enrich_p)
-        dev.off()
+                outprefix <- file.path(info$prefix, paste0("enrich.", slugify(db), ".", slugify(plotname)))
+                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)
+            }
+            reporter$add2(
+                list(name = db, contents = plots),
+                hs = c(info$section, info$name),
+                hs2 = "Enrichment Analysis",
+                ui = "tabs"
+            )
+        }
     }
 }
 
-do_case <- function(casename) {
-    log_info("- Running for case: {casename} ...")
-    case <- cases[[casename]]
-    info <- casename_info(casename, cases, outdir, create = TRUE)
 
-    log_debug("  Calculating average expression ...")
+run_case <- function(name) {
+    log$info("Case: {name} ...")
+    case <- cases[[name]]
+
+    log$info("- Subsetting cells and calculating average expression ...")
     if (!is.null(case$subset)) {
-        tryCatch({
-            sobj <- subset(srtobj, !!parse_expr(case$subset))
-        }, error = function(e) {
-            log_warn("  No cells found for the subset, skipping ...")
-        })
+        subobj <- filter(srtobj, !!parse_expr(case$subset))
     } else {
-        sobj <- srtobj
+        subobj <- srtobj
+    }
+    case$group.by <- case$group.by %||% "Identity"
+    if (is.null(case$ident)) {
+        case$ident <- as.character(unique(subobj@meta.data[[case$group.by]]))
     }
     avgexpr <- AverageExpression(
-        sobj,
+        subobj,
         group.by = case$group.by,
         assays = assay
     )[[assay]]
     # https://github.com/satijalab/seurat/issues/7893
-    colnames(avgexpr) <- as.character(unique(sobj@meta.data[[case$group.by]]))
+    colnames(avgexpr) <- as.character(unique(subobj@meta.data[[case$group.by]]))
     avgexpr <- avgexpr[, case$ident, drop = FALSE]
-    avgexpr <- avgexpr[order(-avgexpr), , drop = FALSE]
 
-    do_enrich(avgexpr, info$casedir)
+    for (idt in case$ident) {
+        log$info("- Processing {idt} ...")
+        info <- case_info(paste0(name, "::", idt), outdir, create = TRUE)
+        expr <- avgexpr[, idt, drop = FALSE]
+        expr <- expr[order(expr, decreasing = TRUE), , drop = FALSE]
+        expr <- expr[1:min(case$n, nrow(expr)), , drop = FALSE]
+        expr <- as.data.frame(expr)
+        expr$gene <- rownames(expr)
+        colnames(expr) <- c("avg_expr", "gene")
+        expr <- expr[, c("gene", "avg_expr"), drop = FALSE]
+
+        log$info("  Performing enrichment analysis ...")
+        process_markers(expr, info, case = list(
+            ident = idt,
+            dbs = case$dbs,
+            enrich_style = case$enrich_style,
+            enrich_plots = case$enrich_plots
+        ))
+    }
 
-    add_case_report(info)
+    invisible()
 }
 
-add_case_report <- function(info) {
-    log_debug("  Adding case report ...")
-    h1 = info$h1
-    h2 = info$h2
-
-    if (!is.null(info$error)) {
-        add_report(
-            list(
-                kind = "descr",
-                content = paste0("Top ", n, " expressing genes")
-            ),
-            list(kind = "error", content = info$error),
-            h1 = h1,
-            h2 = ifelse(h2 == "#", "Top Expressing Genes", h2),
-            h3 = ifelse(h2 == "#", "#", "Top Expressing Genes")
-        )
-    } else {
-        add_report(
-            list(
-                kind = "descr",
-                content = paste0("Top ", n, " expressing genes")
-            ),
-            list(
-                kind = "table",
-                src = file.path(info$casedir, "exprn.txt")
-            ),
-            h1 = h1,
-            h2 = ifelse(h2 == "#", "Top Expressing Genes", h2),
-            h3 = ifelse(h2 == "#", "#", "Top Expressing Genes")
-        )
-
-        add_report(
-            list(
-                kind = "descr",
-                content = paste0("Enrichment analysis for the top ", n, " expressing genes")
-            ),
-            list(kind = "enrichr", dir = info$casedir),
-            h1 = h1,
-            h2 = ifelse(h2 == "#", "Enrichment Analysis", h2),
-            h3 = ifelse(h2 == "#", "#", "Enrichment Analysis")
-        )
-    }
-}
+sapply(names(cases), run_case)
 
-sapply(sort(names(cases)), do_case)
-save_report(joboutdir)
+reporter$save(joboutdir)

biopipen/scripts/scrna/celltypist-wrapper.py

@@ -12,8 +12,9 @@ parser.add_argument(
 parser.add_argument(
     "-c",
     "--over_clustering",
-    default="seurat_clusters",
-    help="Over clustering. Ignored if the column does not exist.",
+    required=False,
+    default=None,
+    help="Over clustering. Error if the column does not exist.",
 )
 
 
@@ -25,8 +26,9 @@ if __name__ == "__main__":
     adata = sc.read_h5ad(args.input)
     over_clustering = args.over_clustering
     if over_clustering and over_clustering not in adata.obs.columns:
-        print("WARNING: Over clustering column not found. Ignoring over clustering.")
-        over_clustering = None
+        raise ValueError(
+            f"Over clustering column '{over_clustering}' not found in AnnData object."
+        )
 
     annotated = celltypist.annotate(
         adata,

biopipen/scripts/scrna/seurat_anndata_conversion.py

@@ -0,0 +1,81 @@
+"""Convert Seurat objects to AnnData format back and forth.
+
+Need R and R packages Seurat, SeuratDisk and biopipen.utils.R installed.
+"""
+
+
+def convert_seurat_to_anndata(
+    input_file,
+    output_file,
+    assay=None,
+    subset=None,
+    rscript="Rscript",
+):
+    """Convert Seurat object to AnnData format.
+
+    Args:
+        input_file (str): Path to the input Seurat RDS or qs/qs2 file.
+        output_file (str): Path to the output AnnData H5AD file.
+        assay (str): Name of the assay to use in the Seurat object.
+        subset (str): An R expression to subset the Seurat object to convert.
+        rscript (RScript): R script executor.
+    """
+    from biopipen.utils.misc import run_command
+
+    script = f"""
+        library(biopipen.utils)
+
+        assay <- {repr(assay) if assay else 'NULL'}
+        subset <- {repr(subset) if subset else 'NULL'}
+
+        ConvertSeuratToAnnData(
+            "{input_file}", "{output_file}", assay = assay, subset = subset
+        )
+    """
+
+    # Save the script to a temporary file
+    from tempfile import NamedTemporaryFile
+    with NamedTemporaryFile(suffix=".R", delete=False) as temp_script:
+        temp_script.write(script.encode('utf-8'))
+        temp_script_path = temp_script.name
+
+    # Run the R script using the provided Rscript command
+    cmd = [rscript, temp_script_path]
+    run_command(cmd, fg=True)
+
+
+def convert_anndata_to_seurat(
+    input_file,
+    output_file,
+    assay=None,
+    rscript="Rscript",
+):
+    """Convert AnnData object to Seurat format.
+
+    Args:
+        input_file (str): Path to the input AnnData H5AD file.
+        output_file (str): Path to the output Seurat RDS or qs/qs2 file.
+        assay (str): Name of the assay to use in the Seurat object.
+        rscript (RScript): R script executor.
+    """
+    from biopipen.utils.misc import run_command
+
+    script = f"""
+        library(biopipen.utils)
+
+        assay <- {repr(assay) if assay else 'NULL'}
+
+        ConvertAnnDataToSeurat(
+            "{input_file}", "{output_file}", assay = assay
+        )
+    """
+
+    # Save the script to a temporary file
+    from tempfile import NamedTemporaryFile
+    with NamedTemporaryFile(suffix=".R", delete=False) as temp_script:
+        temp_script.write(script.encode('utf-8'))
+        temp_script_path = temp_script.name
+
+    # Run the R script using the provided Rscript command
+    cmd = [rscript, temp_script_path]
+    run_command(cmd, fg=True)