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

biopipen/scripts/scrna/SeuratClusterStats-stats.R

@@ -1,108 +1,97 @@
 # Loaded variables: srtfile, outdir, srtobj
 
-stats_defaults = {{envs.stats_defaults | r: todot="-"}}
-stats = {{envs.stats | r: todot="-", skip=1}}
+log$info("stats:")
 
-odir = file.path(outdir, "stats")
+odir <- file.path(outdir, "stats")
 dir.create(odir, recursive=TRUE, showWarnings=FALSE)
-report_toc_file = file.path(odir, "report_toc.json")
-# Realname => {bar: ..., pie: ..., table: ...}
-report_toc = list()
 
-.add_toc = function(name, toc) {
-    report_toc[[name]] <<- toc
-}
 
-.save_toc = function() {
-    writeLines(toJSON(report_toc, pretty = TRUE, auto_unbox = TRUE), report_toc_file)
-}
 
-do_one_stats = function(name) {
-    print(paste0("Doing stats for: ", name))
+do_one_stats <- function(name) {
+    log$info("- Case: {name}")
 
-    toc = list()
+    case <- list_update(stats_defaults, stats[[name]])
+    case <- extract_vars(case, "devpars", "more_formats", "save_code", "save_data", "subset", "descr")
 
-    case = list_update(stats_defaults, stats[[name]])
-    case$devpars = list_update(stats_defaults$devpars, case$devpars)
-    if (isTRUE(case$pie) && !is.null(case$group.by)) {
-        stop(paste0(name, ": pie charts are not supported for group-by"))
+    if (!is.null(subset)) {
+        case$object <- srtobj %>% filter(!!parse_expr(subset))
+    } else {
+        case$object <- srtobj
     }
-
-    figfile = file.path(odir, paste0(slugify(name), ".bar.png"))
-    piefile = file.path(odir, paste0(slugify(name), ".pie.png"))
-    tablefile = file.path(odir, paste0(slugify(name), ".txt"))
-
-    df_cells = srtobj@meta.data
-    if (!is.null(case$subset)) {
-        df_cells = df_cells %>% filter(!!rlang::parse_expr(case$subset))
+    ident <- case$ident %||% GetIdentityColumn(case$object)
+    groupings <- unique(c(case$group_by, case$rows_by, case$columns_by, case$pie_group_by, ident))
+    if (length(groupings) > 0) {
+        for (g in groupings) {
+            case$object <- filter(case$object, !is.na(!!sym(g)))
+        }
     }
 
-    select_cols = c(case$ident, case$group.by, case$split.by)
-    df_cells = df_cells %>%
-        select(all_of(select_cols)) %>%
-        group_by(!!!syms(select_cols)) %>%
-        summarise(.n = n(), .groups = "drop")  %>%
-        mutate(.frac = .n / sum(.n))
-
-    if (isTRUE(case$table)) {
-        toc$table = basename(tablefile)
-        write.table(df_cells, tablefile, sep="\t", quote=FALSE, row.names=FALSE)
+    info <- case_info(name, odir, is_dir = FALSE, create = TRUE)
+    p <- do_call(gglogger::register(CellStatPlot), case)
+    save_plot(p, info$prefix, devpars, formats = c("png", more_formats))
+    if (save_code) {
+        save_plotcode(p, info$prefix,
+            setup = c("library(scplotter)", "load('data.RData')", "invisible(list2env(case, envir = .GlobalEnv))"),
+            "case",
+            auto_data_setup = FALSE)
     }
-    if (isTRUE(case$pie)) {
-        p_pie = df_cells %>%
-            arrange(!!sym(case$ident)) %>%
-            ggplot(aes(x="", y=.n, fill=!!sym(case$ident))) +
-            geom_bar(stat="identity", width=1, alpha=.8, position = position_stack(reverse = TRUE)) +
-            coord_polar("y", start=0) +
-            scale_fill_ucscgb(alpha=.8) +
-            guides(fill = guide_legend(title = case$ident)) +
-            theme_void() +
-            geom_label(
-                if (isTRUE(case$frac))
-                    aes(label=sprintf("%.1f%%", .frac * 100))
-                else
-                    aes(label=.n),
-                position = position_stack(vjust = 0.5),
-                color="#333333",
-                fill="#EEEEEE",
-                size=5
-            )
 
-        if (!is.null(case$split.by)) {
-            p_pie = p_pie + facet_wrap(case$split.by)
-        }
-
-        toc$pie = basename(piefile)
-        png(piefile, width=case$devpars$width, height=case$devpars$height, res=case$devpars$res)
-        print(p_pie)
-        dev.off()
+    frac <- case$frac %||% "none"
+    default_descr <- glue(
+        "The {case$plot_type} plot shows the distribution of cells across categories defined by '{ident}'",
+        "{if (!is.null(case$group_by)) glue(', grouped by {case$group_by}') else ''}",
+        "{if (!is.null(case$split_by)) glue(', and split by {case$split_by}') else ''}. ",
+        "The values represent ",
+        "{if (frac == 'none') 'the number of cells' else glue('the fraction of cells calculated by \"{frac}\"')}. "
+    )
+    if (!is.null(case$comparisons)) {
+        default_descr <- paste0(
+            default_descr,
+            glue("Statistical comparisons were performed between groups using \"{case$pairwise_method %||% 'wilcox.test'}\" method.")
+        )
     }
-
-    ngroups = ifelse(is.null(case$group.by), 1, length(unique(df_cells[[case$group.by]])))
-    nidents = length(unique(df_cells[[case$ident]]))
-    bar_position = ifelse(ngroups > 5, "stack", "dodge")
-    p = df_cells %>%
-        ggplot(aes(
-            x=!!sym(case$ident),
-            y=if (isTRUE(case$frac)) .frac else .n,
-            fill=!!sym(ifelse(is.null(case$group.by), case$ident, case$group.by))
-        )) +
-        geom_bar(stat="identity", position=bar_position, alpha=.8) +
-        theme_prism(axis_text_angle = 90) +
-        scale_fill_manual(values=rep(pal_ucscgb(alpha=.8)(26), 10)[1:max(ngroups, nidents)]) +
-        ylab(ifelse(isTRUE(case$frac), "Fraction of cells", "Number of cells"))
-
-    if (!is.null(case$split.by)) {
-        p = p + facet_wrap(case$split.by)
+    if (save_data) {
+        pdata <- attr(p, "data") %||% p$data
+        if (!inherits(pdata, "data.frame") && !inherits(pdata, "matrix")) {
+            stop("'save_data = TRUE' is not supported for plot_type: ", case$plot_type)
+        }
+        write.table(pdata, paste0(info$prefix, ".data.txt"), sep="\t", quote=FALSE, row.names=FALSE)
+        reporter$add2(
+            list(
+                name = "Plot",
+                contents = list(
+                    list(
+                        kind = "descr",
+                        content = case$descr %||% default_descr
+                    ),
+                    reporter$image(
+                        info$prefix, more_formats, save_code, kind = "image")
+                )
+            ),
+            list(
+                name = "Data",
+                contents = list(
+                    list(
+                        kind = "descr",
+                        content = "Data used directly for the plot"
+                    ),
+                    list(
+                        kind = "table",
+                        src = paste0(info$prefix, ".data.txt"),
+                        data = list(nrows = 100)
+                    )
+                )
+            ),
+            hs = c(info$section, info$name),
+            ui = "tabs"
+        )
+    } else {
+        reporter$add2(
+            list(kind = "descr", content = case$descr %||% default_descr),
+            reporter$image(info$prefix, more_formats, save_code, kind = "image"),
+            hs = c(info$section, info$name)
+        )
     }
-
-    toc$bar = basename(figfile)
-    png(figfile, width=case$devpars$width, height=case$devpars$height, res=case$devpars$res)
-    print(p)
-    dev.off()
-
-    .add_toc(name, toc)
 }
 
 sapply(names(stats), do_one_stats)
-.save_toc()

biopipen/scripts/scrna/SeuratClusterStats.R

@@ -1,21 +1,58 @@
-source("{{biopipen_dir}}/utils/misc.R")
-source("{{biopipen_dir}}/utils/plot.R")
-library(jsonlite)
-library(slugify)
 library(Seurat)
 library(rlang)
 library(dplyr)
+library(tidyr)
 library(tibble)
-library(ggprism)
-library(ggsci)
-library(ggrepel)
+library(glue)
+library(forcats)
 library(tidyseurat)
+library(gglogger)
+library(scplotter)
+library(biopipen.utils)
 
-srtfile = {{in.srtobj | r}}
-outdir = {{out.outdir | r}}
+log <- get_logger()
+reporter <- get_reporter()
 
-srtobj = readRDS(srtfile)
+srtfile <- {{in.srtobj | r}}
+outdir <- {{out.outdir | r}}
+joboutdir <- {{job.outdir | r}}
+mutaters <- {{envs.mutaters | r}}
+cache <- {{envs.cache | r}}
 
+if (isTRUE(cache)) { cache = joboutdir }
+
+log$info("Loading Seurat object ...")
+srtobj = read_obj(srtfile)
+
+log$info("Applying mutaters if any ...")
+if (!is.null(mutaters) && length(mutaters) > 0) {
+    srtobj@meta.data = srtobj@meta.data %>%
+        mutate(!!!lapply(mutaters, parse_expr))
+}
+
+############## clustree ##############
+clustrees_defaults <- {{envs.clustrees_defaults | r: todot="-"}}
+clustrees <- {{envs.clustrees | r: todot="-", skip=1}}
+{% include biopipen_dir + "/scripts/scrna/SeuratClusterStats-clustree.R" %}
+
+############## stats ##############
+stats_defaults = {{envs.stats_defaults | r: todot="-"}}
+stats = {{envs.stats | r: todot="-", skip=1}}
 {% include biopipen_dir + "/scripts/scrna/SeuratClusterStats-stats.R" %}
+
+############## ngenes ##############
+ngenes_defaults <- {{envs.ngenes_defaults | r: todot="-"}}
+ngenes <- {{envs.ngenes | r: todot="-", skip=1}}
+{% include biopipen_dir + "/scripts/scrna/SeuratClusterStats-ngenes.R" %}
+
+############## features ##############
+features_defaults = {{envs.features_defaults | r: todot="-"}}
+features = {{envs.features | r: todot="-", skip=1}}
 {% include biopipen_dir + "/scripts/scrna/SeuratClusterStats-features.R" %}
+
+############## dimplots ##############
+dimplots_defaults = {{envs.dimplots_defaults | r: todot="-"}}
+dimplots = {{envs.dimplots | r: todot="-", skip=1}}
 {% include biopipen_dir + "/scripts/scrna/SeuratClusterStats-dimplots.R" %}
+
+reporter$save(joboutdir)

biopipen/scripts/scrna/SeuratClustering.R

@@ -1,240 +1,43 @@
-source("{{biopipen_dir}}/utils/misc.R")
 
+library(rlang)
 library(Seurat)
-library(future)
-library(tidyr)
-library(dplyr)
+library(biopipen.utils)
 
 set.seed(8525)
 
-srtfile = {{in.srtobj | quote}}
-rdsfile = {{out.rdsfile | quote}}
-envs = {{envs | r: todot="-"}}
-
-options(future.globals.maxSize = 80000 * 1024^2)
-plan(strategy = "multicore", workers = envs$ncores)
-
-.expand_dims = function(args, name = "dims") {
-    # Expand dims from 30 to 1:30
-    if (is.numeric(args[[name]]) && length(args[[name]] == 1)) {
-        args[[name]] = 1:args[[name]]
-    }
-    args
-}
-envs$FindIntegrationAnchors = .expand_dims(envs$FindIntegrationAnchors)
-envs$IntegrateData = .expand_dims(envs$IntegrateData)
-envs$RunUMAP = .expand_dims(envs$RunUMAP)
-envs$FindNeighbors = .expand_dims(envs$FindNeighbors)
-
-sobj = readRDS(srtfile)
-obj_list = SplitObject(sobj, split.by = "Sample")
-rm(sobj)
-
-# Convert envs$FindIntegrationAnchors$reference to index of given as sample names
-samples = unlist(lapply(obj_list, function(x) x@meta.data$Sample[1]))
-if (!is.null(envs$FindIntegrationAnchors$reference)) {
-    ref = envs$FindIntegrationAnchors$reference
-    if (length(ref) == 1) {
-        ref = trimws(strsplit(ref, ",")[[1]])
-    }
-    ref = sapply(ref, function(x) {
-        x_int = as.integer(x)
-        if (!is.na(x_int)) {
-            return(x_int)
-        }
-        which(samples == x)
-    })
-    envs$FindIntegrationAnchors$reference = ref
-}
-
-{% if envs.use_sct -%}
-# ############################
-# Using SCT
-# https://satijalab.org/seurat/articles/integration_rpca.html#performing-integration-on-datasets-normalized-with-sctransform-1
-print("- Performing SCTransform on each sample ...")
-obj_list <- lapply(X = obj_list, FUN = function(x) {
-    print(paste("  Performing SCTransform on sample:", x@meta.data$Sample[1], "..."))
-    # # Needed?
-    # DefaultAssay(x) <- "RNA"
-    args = list_update(envs$SCTransform, list(object = x))
-    do_call(SCTransform, args)
-})
-
-print("- Running SelectIntegrationFeatures ...")
-envs$SelectIntegrationFeatures$object.list = obj_list
-features = do_call(SelectIntegrationFeatures, envs$SelectIntegrationFeatures)
-
-print("- Running PrepSCTIntegration ...")
-envs$PrepSCTIntegration$object.list = obj_list
-envs$PrepSCTIntegration$anchor.features = features
-obj_list = do_call(PrepSCTIntegration, envs$PrepSCTIntegration)
-
-print("- Running PCA on each sample ...")
-obj_list = lapply(X = obj_list, FUN = function(x) {
-    print(paste("  On sample:", x@meta.data$Sample[1], "..."))
-    npcs = if (is.null(envs$RunPCA1$npcs)) 50 else envs$RunPCA1$npcs
-    args = list_setdefault(
-        envs$RunPCA1,
-        object = x,
-        features = features,
-        verbose = FALSE,
-        npcs = min(npcs, ncol(x) - 1)
-    )
-    do_call(RunPCA, args)
-})
-
-print("- Running FindIntegrationAnchors ...")
-if (!is.null(envs$FindIntegrationAnchors$reference)) {
-    print(
-        paste(
-            "  Using samples as reference:",
-            paste(envs$FindIntegrationAnchors$reference, collapse = ", ")
-        )
-    )
-}
-fia_args = list_setdefault(
-    envs$FindIntegrationAnchors,
-    object.list = obj_list,
-    anchor.features = features,
-    normalization.method = "SCT",
-    reduction = "rpca",
-    dims = 1:30,
-    k.score = 30
-)
-min_dim = min(unlist(lapply(obj_list, ncol))) - 1
-fia_args$dims = 1:min(min_dim, max(fia_args$dims))
-fia_args$k.score = min(30, min_dim - 1)
-anchors = do_call(FindIntegrationAnchors, fia_args)
-
-print("- Running IntegrateData ...")
-envs$IntegrateData$anchorset = anchors
-id_args = list_setdefault(
-    envs$IntegrateData,
-    normalization.method = "SCT",
-    dims = 1:30
-)
-id_args$dims = 1:min(min_dim, max(id_args$dims))
-tryCatch({
-    obj_list = do_call(IntegrateData, id_args)
-}, error = function(e) {
-    msg = ""
-    if (grepl("number of items to replace is not a multiple of replacement length", e)) {
-        default_kweight = 100
-        if (!is.null(envs$IntegrateData$k.weight)) {
-            default_kweight = envs$IntegrateData$k.weight
-        }
-        msg = paste0(
-            "It's possible that you have too few cells in some samples, ",
-            "causing a small number of anchor cells in the anchorset. \n",
-            "  Try changing `k.weight` for `IntegrateData` by setting ",
-            "`envs.IntegrateData.k-weight` to a smaller number (it's now ",
-            default_kweight, "). \n",
-            "  See also https://github.com/satijalab/seurat/issues/6341"
-        )
-    }
-    stop(paste0(msg, "\n", e))
-})
-
-{%- else -%}
-# ############################
-# Using rpca
-# https://satijalab.org/seurat/articles/integration_rpca.html
-print("- Performing NormalizeData + FindVariableFeatures on each sample ...")
-obj_list <- lapply(X = obj_list, FUN = function(x) {
-    print(paste("  On sample:", x@meta.data$Sample[1], "..."))
-    DefaultAssay(x) <- "RNA"
-    args = list_update(envs$NormalizeData, list(object = x))
-    x <- do_call(NormalizeData, args)
-
-    args = list_update(envs$FindVariableFeatures, list(object = x))
-    do_call(FindVariableFeatures, args)
-})
-
-
-print("- Running SelectIntegrationFeatures ...")
-envs$SelectIntegrationFeatures$object.list = obj_list
-features = do_call(SelectIntegrationFeatures, envs$SelectIntegrationFeatures)
-
-print("- Running ScaleData + RunPCA on each sample ...")
-obj_list <- lapply(X = obj_list, FUN = function(x) {
-    print(paste("  On sample:", x@meta.data$Sample[1], "..."))
-    args = list_setdefault(envs$ScaleData1, object = x, features = features)
-    x <- do_call(ScaleData, args)
-
-    npcs = if (is.null(envs$RunPCA1$npcs)) 50 else envs$RunPCA1$npcs
-    args = list_setdefault(
-        envs$RunPCA1,
-        object = x,
-        features = features,
-        verbose = FALSE,
-        npcs = min(npcs, ncol(x) - 1)
-    )
-    do_call(RunPCA, args)
-})
-
-print("- Running FindIntegrationAnchors ...")
-if (!is.null(envs$FindIntegrationAnchors$reference)) {
-    print(
-        paste(
-            "  Using samples as reference:",
-            paste(envs$FindIntegrationAnchors$reference, collapse = ", ")
-        )
-    )
-}
-fia_args = list_setdefault(
-    envs$FindIntegrationAnchors,
-    object.list = obj_list,
-    anchor.features = features,
-    reduction = "rpca",
-    dims = 1:30,
-    k.score = 30
+srtfile <- {{in.srtobj | r}}
+outfile <- {{out.outfile | r}}
+joboutdir <- {{job.outdir | r}}
+RunPCAArgs <- {{envs.RunPCA | r: todot="-"}}
+FindNeighborsArgs <- {{envs.FindNeighbors | r: todot="-"}}
+FindClustersArgs <- {{envs.FindClusters | r: todot="-"}}
+RunUMAPArgs <- {{envs.RunUMAP | r: todot="-"}}
+ident <- {{envs.ident | r }}
+cache <- {{envs.cache | r}}
+ncores <- {{envs.ncores | r}}
+
+FindClustersArgs$cluster.name <- FindClustersArgs$cluster.name %||% ident %||% "seurat_clusters"
+
+log <- get_logger()
+
+# options(str = strOptions(vec.len = 5, digits.d = 5))
+options(future.globals.maxSize = Inf)
+plan(strategy = "multicore", workers = ncores)
+
+log$info("Reading Seurat object ...")
+sobj <- read_obj(srtfile)
+
+if (isTRUE(cache)) { cache <- joboutdir }
+
+sobj <- RunSeuratClustering(
+    sobj,
+    RunPCAArgs = RunPCAArgs,
+    RunUMAPArgs = RunUMAPArgs,
+    FindNeighborsArgs = FindNeighborsArgs,
+    FindClustersArgs = FindClustersArgs,
+    log = log,
+    cache = cache
 )
-min_dim = min(unlist(lapply(obj_list, ncol))) - 1
-fia_args$dims = 1:min(min_dim, max(fia_args$dims))
-fia_args$k.score = min(30, min_dim - 1)
-anchors = do_call(FindIntegrationAnchors, fia_args)
-
-print("- Running IntegrateData ...")
-envs$IntegrateData$anchorset = anchors
-id_args = list_setdefault(envs$IntegrateData, dims = 1:30)
-id_args$dims = 1:min(min_dim, max(id_args$dims))
-obj_list = do_call(IntegrateData, id_args)
-
-DefaultAssay(obj_list) <- "integrated"
-
-envs$ScaleData$object = obj_list
-obj_list = do_call(ScaleData, envs$ScaleData)
-
-{%- endif %}
-
-print("- Running RunPCA ...")
-pca_args = list_setdefault(
-    envs$RunPCA,
-    object = obj_list,
-    npcs = 50
-)
-pca_args$npcs = min(pca_args$npcs, ncol(obj_list) - 1)
-obj_list = do_call(RunPCA, pca_args)
-
-print("- Running RunUMAP ...")
-umap_args = list_setdefault(
-    envs$RunUMAP,
-    object = obj_list,
-    dims = 1:30
-)
-umap_args$dims = 1:min(max(umap_args$dims), ncol(obj_list) - 1)
-obj_list = do_call(RunUMAP, umap_args)
-
-print("- Running FindNeighbors ...")
-envs$FindNeighbors$object = obj_list
-obj_list = do_call(FindNeighbors, envs$FindNeighbors)
-
-print("- Running FindClusters ...")
-envs$FindClusters$object = obj_list
-obj_list = do_call(FindClusters, envs$FindClusters)
-
-nclusters = length(unique(Idents(obj_list)))
-print(paste0("- Identified ", nclusters, " clusters."))
 
-print("- Saving results ...")
-saveRDS(obj_list, file = rdsfile)
+log$info("Saving results ...")
+save_obj(sobj, file = outfile)

biopipen/scripts/scrna/SeuratLoading.R

@@ -1,7 +1,7 @@
 library(Seurat)
 
-metafile = {{in.metafile | quote}}
-rdsfile = {{out.rdsfile | quote}}
+metafile = {{in.metafile | r}}
+rdsfile = {{out.rdsfile | r}}
 
 metadata = read.table(
     metafile,