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

biopipen/scripts/scrna/MetaMarkers.R

@@ -15,9 +15,9 @@ library(tidyseurat)
 
 setEnrichrSite("Enrichr")
 
-srtfile <- {{ in.srtobj | quote }}
-outdir <- {{ out.outdir | quote }}
-joboutdir <- {{ job.outdir | quote }}
+srtfile <- {{ in.srtobj | r }}
+outdir <- {{ out.outdir | r }}
+joboutdir <- {{ job.outdir | r }}
 ncores <- {{ envs.ncores | int }}
 mutaters <- {{ envs.mutaters | r }}
 idents <- {{ envs.idents | r }}

biopipen/scripts/scrna/ModuleScoreCalculator.R

@@ -1,16 +1,17 @@
-{{ biopipen_dir | joinpaths: "utils", "misc.R" | source_r }}
-
 library(Seurat)
 library(dplyr)
+library(biopipen.utils)
 
 sobjfile <- {{in.srtobj | r}}
 outfile <- {{out.rdsfile | r}}
 defaults <- {{envs.defaults | r}}
 modules <- {{envs.modules | r}}
 
+log <- get_logger()
+
 # load seurat object
-log_info("Loading Seurat object ...")
-sobj <- readRDS(sobjfile)
+log$info("Loading Seurat object ...")
+sobj <- read_obj(sobjfile)
 
 aggs <- list(
     mean = mean,
@@ -36,7 +37,7 @@ for (key in names(modules)) {
     agg <- aggs[[module$agg]]
     module$keep <- NULL
     module$agg <- NULL
-    log_info("Calculating module '{key}' ...")
+    log$info("Calculating module '{key}' ...")
     is_cc <- FALSE
     if (!is.null(module$kind) && module$kind %in% c("diffmap", "diffusion_map")) {
         library(destiny)
@@ -47,30 +48,30 @@ for (key in names(modules)) {
         module$kind <- NULL
 
         if (!is.null(module$n_pcs)) {
-            log_info("- Using cell embeddings from PCA reduction ...")
+            log$info("- Using cell embeddings from PCA reduction ...")
             module$data <- Embeddings(sobj, reduction = "pca")
             if (module$n_pcs > ncol(module$data)) {
-                log_warn("- `n_pcs` ({module$n_pcs}) is larger than the number of PCs, using all {ncol(module$data)} PCs ...")
+                log$warn("- `n_pcs` ({module$n_pcs}) is larger than the number of PCs, using all {ncol(module$data)} PCs ...")
             }
             module$data <- module$data[, 1:min(module$n_pcs, ncol(module$data))]
             module$n_pcs <- NULL
         } else {
-            log_info("- Using assay data ...")
+            log$info("- Using assay data ...")
             module$data <- GetAssayData(sobj, layer = "data")
         }
 
-        log_info("- Calculating diffusion map ...")
+        log$info("- Calculating diffusion map ...")
         dm <- do_call(DiffusionMap, module)
         ev <- eigenvectors(dm)
 
-        log_info("- Creating DimReduc object ...")
+        log$info("- Creating DimReduc object ...")
         sobj[[key]] <- CreateDimReducObject(
             embeddings = data.matrix(as.data.frame(ev[, 1:features])),
             key = paste0(key, "_")
         )
 
         # add to meta.data
-        log_info("- Adding to meta.data ...")
+        log$info("- Adding to meta.data ...")
         sobj <- AddMetaData(
             sobj,
             sobj[[key]]@cell.embeddings,
@@ -134,5 +135,5 @@ for (key in names(modules)) {
 }
 
 # save seurat object
-print("Saving Seurat object ...")
-saveRDS(sobj, outfile)
+log$info("Saving Seurat object ...")
+save_obj(sobj, outfile)

biopipen/scripts/scrna/RadarPlots.R

@@ -40,7 +40,7 @@ cases = {{envs.cases | r}}
 # sections = c()
 
 log_info("- Reading srtobj ...")
-srtobj = readRDS(srtfile)
+srtobj = biopipen.utils::read_obj(srtfile)
 meta = srtobj@meta.data
 
 log_info("- Mutating meta data if needed ...")

biopipen/scripts/scrna/ScFGSEA.R

@@ -1,10 +1,7 @@
-{{ biopipen_dir | joinpaths: "utils", "misc.R" | source_r }}
-{{ biopipen_dir | joinpaths: "utils", "gsea.R" | source_r }}
-{{ biopipen_dir | joinpaths: "utils", "mutate_helpers.R" | source_r }}
-
 library(rlang)
 library(Seurat)
 library(tidyseurat)
+library(biopipen.utils)
 
 srtfile <- {{in.srtobj | r}}  # nolint
 outdir <- {{out.outdir | r}}  # nolint
@@ -14,23 +11,34 @@ group.by <- {{envs["group-by"] | r}}  # nolint
 ident.1 <- {{envs["ident-1"] | r}}  # nolint
 ident.2 <- {{envs["ident-2"] | r}}  # nolint
 each <- {{envs.each | r}}  # nolint
-prefix_each <- {{envs.prefix_each | r}}  # nolint
 subset <- {{envs.subset | r}}  # nolint
-section <- {{envs.section | r}}  # nolint
 gmtfile <- {{envs.gmtfile | r}}  # nolint
 method <- {{envs.method | r}}  # nolint
 top <- {{envs.top | r}}  # nolint
-minsize <- {{envs.minsize | r}}  # nolint
-maxsize <- {{envs.maxsize | 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
 
-log_info("- Reading srtobj...")
+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)) {
+    srtobj@meta.data$Identity <- Idents(srtobj)
+}
 
-srtobj <- readRDS(srtfile)
 if (!is.null(mutaters) && length(mutaters) > 0) {
+    log$info("Mutating metadata columns ...")
     srtobj@meta.data <- srtobj@meta.data %>% mutate(!!!lapply(mutaters, parse_expr))
 }
 
@@ -39,69 +47,87 @@ defaults <- list(
     ident.1 = ident.1,
     ident.2 = ident.2,
     each = each,
-    prefix_each = prefix_each,
     subset = subset,
-    section = section,
     gmtfile = gmtfile,
     method = method,
     top = top,
     minsize = minsize,
     maxsize = maxsize,
     eps = eps,
+    allpathway_plots_defaults = allpathway_plots_defaults,
+    allpathway_plots = allpathway_plots,
     ncores = ncores,
     rest = rest
 )
 
 expand_each <- function(name, case) {
     outcases <- list()
-    if (is.null(case$each) || nchar(case$each) == 0) {
-        if (is.null(case$section) || case$section == "DEFAULT") {
-            outcases[[name]] <- case
-        } else {
-            outcases[[paste0(case$section, "::", 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 {
-        if (!is.null(case$section) && case$section != "DEFAULT") {
-            log_warn("  Ignoring `section` in case `{name}` when `each` is set.")
-            case$section <- NULL
-        }
-        if (is.null(case$subset)) {
-            eachs <- srtobj@meta.data %>%
+        eachs <- if (!is.null(case$subset)) {
+            srtobj@meta.data %>%
+                filter(!!parse_expr(case$subset)) %>%
                 pull(case$each) %>% na.omit() %>% unique() %>% as.vector()
         } else {
-            eachs <- srtobj@meta.data %>% dplyr::filter(!!!parse_exprs(case$subset)) %>%
+            srtobj@meta.data %>%
                 pull(case$each) %>% na.omit() %>% unique() %>% as.vector()
         }
+
+        if (length(cases) == 0 && name == "GSEA") {
+            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
-                ))
-
-            if (isTRUE(case$prefix_each)) {
-                key <- paste0(name, "::", case$each, " - ", each)
+            newname <- paste0(case$each, "::", each)
+            newcase <- case
+
+            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 {
-                key <- paste0(name, "::", each)
+                newcase$subset <- paste0(bQuote(case$each), " == '", each, "'")
             }
-            outcases[[key]] <- case
-            outcases[[key]]$section <- name
-            outcases[[key]]$group.by <- by
+
+            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
 }
 
-log_info("- Expanding cases...")
-cases <- expand_cases(cases, defaults, expand_each)
+log$info("Expanding cases...")
+cases <- expand_cases(cases, defaults, expand_each, default_case = "GSEA")
 
 
 ensure_sobj <- function(expr, allow_empty) {
     tryCatch({ expr }, error = function(e) {
         if (allow_empty) {
-            log_warn("  Ignoring this case: {e$message}")
+            log$warn("  Ignoring this case: {e$message}")
             return(NULL)
         } else {
             stop(e)
@@ -109,60 +135,121 @@ 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)) {
 
-do_case <- function(name, case) {
-    log_info("- Handling case: {name} ...")
-    info <- casename_info(name, cases, outdir, create = TRUE)
+        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
+            }
 
-    allow_empty = startsWith(case$group.by, "..")
+            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...")
+    log$info("  Preparing expression matrix...")
     sobj <- ensure_sobj({ srtobj %>% filter(!is.na(!!sym(case$group.by))) }, allow_empty)
-    if (is.null(sobj)) { return() }
+    if (is.null(sobj)) {
+        reporter$add2(
+            list(
+                kind = "error",
+                content = paste0("No cells with non-NA `", case$group.by, "` in the Seurat object.")
+            ),
+            hs = c(info$section, info$name)
+        )
+        return(NULL)
+    }
 
     if (!is.null(case$subset)) {
         sobj <- ensure_sobj({ sobj %>% filter(!!!parse_exprs(case$subset)) }, allow_empty)
-        if (is.null(sobj)) { return() }
+        if (is.null(sobj)) {
+            reporter$add2(
+                list(
+                    kind = "error",
+                    content = paste0("No cells with non-NA `", case$group.by, "` in the Seurat object.")
+                ),
+                hs = c(info$section, info$name)
+            )
+            return(NULL)
+        }
     }
     if (!is.null(case$ident.2)) {
         sobj <- ensure_sobj({ sobj %>% filter(!!sym(case$group.by) %in% c(case$ident.1, case$ident.2)) }, allow_empty)
-        if (is.null(sobj)) { return() }
+        if (is.null(sobj)) {
+            reporter$add2(
+                list(
+                    kind = "error",
+                    content = paste0("No cells with non-NA `", case$group.by, "` in the Seurat object.")
+                ),
+                hs = c(info$section, info$name)
+            )
+            return(NULL)
+        }
     }
 
     allclasses <- sobj@meta.data[, case$group.by, drop = TRUE]
     if (is.null(case$ident.2)) {
-        case$ident.2 <- ".rest"
-        allclasses[allclasses != case$ident.1] <- ".rest"
+        case$ident.2 <- "Other"
+        allclasses[allclasses != case$ident.1] <- "Other"
     }
     exprs <- GetAssayData(sobj, layer = "data")
 
     # get preranks
-    log_info("  Getting preranks...")
-    ranks <- prerank(exprs, case$ident.1, case$ident.2, allclasses, case$method)
+    log$info("  Getting preranks...")
+    ranks <- RunGSEAPreRank(exprs, allclasses, case$ident.1, case$ident.2, case$method)
     write.table(
-        ranks,
-        file.path(info$casedir, "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
     )
-    if (sum(is.na(ranks[, 2])) == nrow(ranks)) {
+    if (all(is.na(ranks))) {
         if (length(allclasses) < 100) {
-            log_warn("  Ignoring this case because all gene ranks are NA and there are <100 cells.")
-            cat(
-                paste0("Not enough cells (n = ", length(allclasses), ") to run fgsea."),
-                file = file.path(info$casedir, "fgsea.log")
-            )
-            add_report(
+            log$warn("  Ignoring this case because all gene ranks are NA and there are <100 cells.")
+            reporter$add2(
                 list(
                     kind = "error",
                     content = paste0("Not enough cells (n = ", length(allclasses), ") to run fgsea.")
                 ),
-                h1 = info$h1,
-                h2 = info$h2
+                hs = c(info$section, info$name)
             )
-            return()
+            return(NULL)
         } else {
             stop(paste0(
                 "All gene ranks are NA (# cells = ",
@@ -175,20 +262,88 @@ do_case <- function(name, case) {
     }
 
     # run fgsea
-    log_info("  Running fgsea...")
-    case$rest$minSize <- case$minsize
-    case$rest$maxSize <- case$maxsize
+    log$info("  Running fgsea...")
+    case$rest$ranks <- ranks
+    case$rest$genesets <- ParseGMT(case$gmtfile)
+    case$rest$minSize <- case$rest$minSize %||% case$rest$minsize %||% case$minsize
+    case$rest$maxSize <- case$rest$maxSize %||% case$rest$maxsize %||% case$maxsize
     case$rest$eps <- case$eps
     case$rest$nproc <- case$ncores
-    runFGSEA(ranks, case$gmtfile, case$top, info$casedir, case$rest)
+    case$rest$minsize <- NULL
+    case$rest$maxsize <- NULL
+    result <- do_call(RunGSEA, case$rest)
+    write.table(
+        result,
+        file.path(info$prefix, "fgsea.tsv"),
+        row.names = FALSE,
+        col.names = TRUE,
+        sep = "\t",
+        quote = FALSE
+    )
+
+    aspect.ratio <- sqrt(case$top) / sqrt(10)
+    p_summary <- VizGSEA(
+        result,
+        plot_type = "summary",
+        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 / 1.5, width = attr(p_summary, "width") * 100),
+        formats = "png"
+    )
+
+    p_gsea <- VizGSEA(
+        result,
+        plot_type = "gsea",
+        gs = result$pathway[1:min(case$top, nrow(result))]
+    )
+    save_plot(
+        p_gsea,
+        file.path(info$prefix, "pathways"),
+        devpars = list(res = 100, height = attr(p_gsea, "height") * 100, width = attr(p_gsea, "width") * 100),
+        formats = "png"
+    )
+
 
-    add_report(
-        list(kind = "fgsea", dir = info$casedir),
-        h1 = info$h1,
-        h2 = info$h2
+    reporter$add2(
+        list(
+            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.tsv"), data = list(nrows = 50))
+            )
+        ),
+        list(
+            name = "Summary Plot",
+            contents = list(
+                list(kind = "descr", content = paste0("Showing top ", case$top, " pathways.")),
+                list(kind = "image", src = file.path(info$prefix, "summary.png"))
+            )
+        ),
+        list(
+            name = "GSEA Plots",
+            contents = list(
+                list(kind = "descr", content = paste0("Showing top ", case$top, " pathways.")),
+                list(kind = "image", src = file.path(info$prefix, "pathways.png"))
+            )
+        ),
+        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, cases[[name]]))
+sapply(names(cases), function(name) do_case(name))
 
-save_report(joboutdir)
+reporter$save(joboutdir)

biopipen/scripts/scrna/ScSimulation.R

@@ -1,8 +1,7 @@
-{{ biopipen_dir | joinpaths: "utils", "misc.R" | source_r }}
-
 library(rlang)
 library(splatter)
 library(scater)
+library(biopipen.utils)
 
 # Load template variables
 seed <- {{ in.seed | r }}
@@ -14,11 +13,13 @@ outtype <- {{ envs.outtype | r }}
 method <- {{ envs.method | r }}
 user_params <- {{ envs.params | r: todot="-" }}
 
-log_info("Generating simulation parameters ...")
+log <- get_logger()
+
+log$info("Generating simulation parameters ...")
 
 seed <- seed %||% 1
 if (length(seed) > 1) {
-    log_warn("- multiple seeds provided, using the first one")
+    log$warn("- multiple seeds provided, using the first one")
     seed <- seed[1]
 }
 if (is.character(seed)) {
@@ -41,7 +42,7 @@ user_params$object = params
 do_call(setParams, user_params)
 
 
-log_info("Saving simulation parameters to file ...")
+log$info("Saving simulation parameters to file ...")
 
 sim <- splatSimulate(params, method = method, verbose = TRUE)
 
@@ -49,16 +50,16 @@ outtype <- tolower(outtype)
 if (outtype == "sce") outtype <- "singlecellexperiment"
 
 if (outtype == "singlecellexperiment") {
-    log_info("Saving simulation to file ...")
-    saveRDS(sim, file = outfile)
+    log$info("Saving simulation to file ...")
+    save_obj(sim, file = outfile)
 } else {
-    log_info("Converting simulation to Seurat object ...")
+    log$info("Converting simulation to Seurat object ...")
     cnts <- SingleCellExperiment::counts(sim)
     sobj <- Seurat::CreateSeuratObject(counts = cnts, project = proj)
     rm(sim)
     rm(cnts)
     gc()
 
-    log_info("Saving simulation to file ...")
-    saveRDS(sobj, file = outfile)
+    log$info("Saving simulation to file ...")
+    save_obj(sobj, file = outfile)
 }