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

biopipen/scripts/scrna/SeuratClusterStats-clustree.R

@@ -0,0 +1,87 @@
+# srtobj, clustrees_defaults, clustrees
+
+log$info("clustrees:")
+
+if (
+    (is.null(clustrees) || length(clustrees) == 0) &&
+    (is.null(clustrees_defaults$prefix) || isFALSE(clustrees_defaults$prefix))) {
+    log$warn("- no case specified, skipping ...")
+} else {  # clustrees set or prefix is not empty
+    odir = file.path(outdir, "clustrees")
+    dir.create(odir, recursive=TRUE, showWarnings=FALSE)
+
+    if ((is.null(clustrees) || length(clustrees) == 0) && isTRUE(clustrees_defaults$prefix)) {
+        clustrees <- list()
+        for (key in names(srtobj@commands)) {
+            if (startsWith(key, "FindClusters") && length(srtobj@commands[[key]]$resolution) > 1) {
+                pref <- substring(key, 14)
+                if (pref == "") {
+                    pref <- biopipen.utils::GetIdentityColumn(srtobj)
+                }
+
+                clustrees[[pref]] <- list(prefix = pref)
+            }
+        }
+    }
+    if (length(clustrees) == 0) {
+        log$warn("- no case found, skipping ...")
+    } else {
+        reporter$add(
+            list(
+                kind = "descr",
+                content = 'The clustree plots displays clustering results from the Seurat object across different
+                resolutions of the clustering algorithm
+                (<a target="_blank" href="https://satijalab.org/seurat/reference/findclusters">Seurat::FindClusters</a>).
+                Each node represents a cluster, with the resolution levels labeled along the vertical (y) axis.
+                The size of each node reflects the number of cells in that cluster. Edges connect clusters between
+                adjacent resolutions and indicate how cells transition between clusters as resolution increases.
+                The thickness of the edges corresponds to the proportion of shared cells (in_prop) between clusters,
+                where darker lines signify a higher overlap (up to 100%). The color of the edges indicates the actual
+                number of cells that transitioned between clusters.'
+            ),
+            h1 = "Clustree plots"
+        )
+
+        reports <- list()
+        for (name in names(clustrees)) {
+            if (is.null(clustrees[[name]]$prefix)) {
+                stop(paste0("clustrees: prefix is required for case: ", name))
+            }
+            log$info("- Case: {name} ...")
+            case <- list_update(clustrees_defaults, clustrees[[name]])
+            extract_vars(case, "devpars", "more_formats", "save_code")
+
+            prefix <- sub("\\.$", "", case$prefix)
+            case$prefix <- paste0(prefix, ".")
+            case$object <- srtobj
+
+            command <- srtobj@commands[[paste0("FindClusters.", prefix)]] %||%
+                (if(prefix == "seurat_clusters") srtobj@commands$FindClusters else NULL)
+
+            if (is.null(command)) {
+                resolution <- substring(colnames(case$x), nchar(case$prefix) + 1)
+            } else {
+                resolution <- command$resolution
+            }
+            resolution_used <- resolution[length(resolution)]
+
+            plot_prefix <- file.path(odir, paste0(slugify(prefix), ".clustree"))
+            p <- do_call(gglogger::register(ClustreePlot), case)
+            save_plot(p, plot_prefix, devpars, formats = c("png", more_formats))
+
+            if (save_code) {
+                save_plotcode(p, plot_prefix,
+                    setup = c("library(scplotter)", "load('data.RData')", "invisible(list2env(case, envir = .GlobalEnv))"),
+                    "case",
+                    auto_data_setup = FALSE)
+            }
+            reports[[length(reports) + 1]] <- reporter$image(
+                plot_prefix, more_formats, save_code, kind = "image",
+                descr = paste0("Resolutions: ", paste(resolution, collapse = ", "), "; resolution used: ", resolution_used)
+            )
+        }
+        reports$h1 <- "Clustree plots"
+        reports$ui <- "table_of_images"
+        do_call(reporter$add, reports)
+    }
+}

biopipen/scripts/scrna/SeuratClusterStats-dimplots.R

@@ -1,44 +1,50 @@
 # Loaded variables: srtfile, outdir, srtobj
 
-dimplots_defaults = {{envs.dimplots_defaults | r: todot="-"}}
-dimplots = {{envs.dimplots | r: todot="-", skip=1}}
+# dimplots_defaults = {{envs.dimplots_defaults | r: todot="-"}}
+# dimplots = {{envs.dimplots | r: todot="-", skip=1}}
+log$info("dimplots:")
 
-odir = file.path(outdir, "dimplots")
+odir <- file.path(outdir, "dimplots")
 dir.create(odir, recursive=TRUE, showWarnings=FALSE)
-report_toc_file = file.path(odir, "report_toc.json")
-# Realname => file
-report_toc = list()
 
 do_one_dimplot = function(name) {
-    print(paste0("Doing dimplots for: ", name))
+    log$info("- Case: {name}")
 
-    case = list_update(dimplots_defaults, dimplots[[name]])
-    case$devpars = list_update(dimplots_defaults$devpars, dimplots[[name]]$devpars)
-    case$object = srtobj
-    if (is.null(case$cols)) {
-        case$cols = pal_ucscgb()(26)
-    }
+    case <- list_update(dimplots_defaults, dimplots[[name]])
 
-    excluded_args = c("devpars", "ident")
-    for (arg in excluded_args) {
-        assign(arg, case[[arg]])
-        case[[arg]] = NULL
-    }
+    # Get functional arguments and inconsistent arguments
+    subset <- case$subset; case$subset <- NULL
+    reduction <- case$reduction; case$reduction <- NULL
+    devpars <- case$devpars; case$devpars <- NULL
 
-    if (is.null(case$group.by) && !is.null(ident)) {
-        case$group.by = ident
-    }
+    # Normalize arguments
+    reduction <- if (reduction %in% c("dim", "auto")) DefaultDimReduc(srtobj) else reduction
+    devpars <- list_update(dimplots_defaults$devpars, devpars)
+    key <- paste0("sub_umap_", case$group_by)
 
-    if (case$reduction %in% c("dim", "auto")) {
-        case$reduction = NULL
+    if (!is.null(subset)) {
+        case$object <- srtobj %>% filter(!!parse_expr(subset))
+    } else {
+        case$object <- srtobj
     }
-    report_toc[[name]] <<- paste0(slugify(name), ".dim.png")
-    figfile = file.path(odir, report_toc[[name]])
-    png(figfile, width=devpars$width, height=devpars$height, res=devpars$res)
-    p = do_call(DimPlot, case)
-    print(p)
-    dev.off()
+    if (key %in% names(case$object@reductions) && is.null(reduction)) {
+        case$reduction = key
+    } else {
+        case$reduction = reduction
+    }
+
+    p <- do_call(CellDimPlot, case)
+    prefix <- file.path(odir, paste0(slugify(name), ".dim"))
+    save_plot(p, prefix, devpars)
+
+    reporter$add(
+        list(
+            kind = "descr",
+            content = paste0("Dimensionality reduction plot for ", case$group_by)
+        ),
+        reporter$image(prefix, "pdf", FALSE),
+        h1 = name
+    )
 }
 
 sapply(names(dimplots), do_one_dimplot)
-.save_toc()

biopipen/scripts/scrna/SeuratClusterStats-features.R

@@ -1,29 +1,36 @@
 # Loaded variables: srtfile, outdir, srtobj
 
-features_defaults = {{envs.features_defaults | r: todot="-"}}
-features = {{envs.features | r: todot="-", skip=1}}
+# features_defaults = {{envs.features_defaults | r: todot="-"}}
+# features = {{envs.features | r: todot="-", skip=1}}
+log$info("features:")
 
 odir = file.path(outdir, "features")
 dir.create(odir, recursive=TRUE, showWarnings=FALSE)
-report_toc_file = file.path(odir, "report_toc.json")
-# Section => list(
-#   list(name?, kind, file),
-#   ...
-# )
-report_toc = list()
-
-.add_toc = function(section, toc) {
-    if (section %in% names(report_toc)) {
-        report_toc[[section]][[length(report_toc[[section]]) + 1]] <<- toc
-    } else {
-        report_toc[[section]] <<- list(toc)
-    }
-}
 
-.get_features = function(features) {
+# highly variable features
+hvf <- NULL
+
+.get_features = function(features, object) {
     if (is.null(features)) { features = 20 }
     if (is.numeric(features)) {
-        return (VariableFeatures(srtobj)[1:features])
+        if (!is.null(hvf)) {
+            return(hvf[1:features])
+        }
+        vf <- VariableFeatures(object)
+        if (length(vf) == 0) {
+            if (DefaultAssay(object) == "SCT") {
+                # Still use RNA assay to find variable features
+                # See
+                # https://github.com/satijalab/seurat/issues/6064
+                # https://github.com/satijalab/seurat/issues/8238
+                # https://github.com/satijalab/seurat/issues/5761
+                vf <- FindVariableFeatures(object, nfeatures = features, assay = "RNA")
+            } else {
+                vf <- FindVariableFeatures(object, nfeatures = features)
+            }
+        }
+        hvf <<- vf
+        return(hvf[1:features])
     }
     if (is.character(features) && length(features) > 1) {
         return (features)
@@ -46,192 +53,136 @@ report_toc = list()
         }
     }
 
+    if (is.list(features)) {
+        return(lapply(features, function(x) {.get_features(x, object) }))
+    }
+
     return (trimws(unlist(strsplit(features, ","))))
 }
 
-do_one_features = function(name) {
-    print(paste0("Doing features for: ", name))
-
-    case = list_update(features_defaults, features[[name]])
-    toc = list()
-    if (!is.null(case$section)) { toc$name = name }
-    case$devpars = list_update(features_defaults$devpars, features[[name]]$devpars)
-    excluded_args = c(
-        "section",
-        "devpars",
-        "subset",
-        "plus",
-        "ident",
-        "kind"
-    )
+do_one_features <- function(name) {
+    log$info("- Case: {name}")
 
-    fn = NULL
-    default_devpars = NULL
-    if ("ridge" %in% case$kind) {
-        case$kind = "ridge"
-        if (is.null(case$cols)) {
-            case$cols = pal_ucscgb(alpha = .8)(26)
-        }
-        excluded_args = c(excluded_args, "split.by")
-        fn = RidgePlot
-        default_devpars = function(features, ncol, uidents) {
-            if (is.null(ncol)) { ncol = 1 }
-            list(
-                width = 400 * ncol,
-                height = ceiling(length(features) / ncol) * ifelse(length(uidents) < 10, 300, 400),
-                res = 100
-            )
-        }
-    } else if ("vln" %in% case$kind || "violin" %in% case$kind) {
-        case$kind = "violin"
-        if (is.null(case$cols)) {
-            case$cols = pal_ucscgb(alpha = .8)(26)
-        }
-        fn = VlnPlot
-        default_devpars = function(features, ncol, uidents) {
-            if (is.null(ncol)) { ncol = 1 }
-            list(
-                width = 400 * ncol,
-                height = ceiling(length(features) / ncol) * 400,
-                res = 100
-            )
-        }
-    } else if ("feature" %in% case$kind) {
-        case$kind = "feature"
-        if (is.null(case$cols)) {
-            case$cols = c("lightgrey", pal_ucscgb()(1))
-        }
-        excluded_args = c(excluded_args, "group.by", "assay")
-        case$shape.by = case$group.by
-        fn = FeaturePlot
-        default_devpars = function(features, ncol, uidents) {
-            if (is.null(ncol)) { ncol = 1 }
-            list(
-                width = 400 * ncol,
-                height = ceiling(length(features) / ncol) * 300,
-                res = 100
-            )
-        }
-    } else if ("dot" %in% case$kind) {
-        case$kind = "dot"
-        if (is.null(case$cols)) {
-            case$cols = c("lightgrey", pal_ucscgb()(1))
-        }
-        if (is.null(case$plus)) {
-            case$plus = 'theme_prism(axis_text_angle=90)'
-        }
-        excluded_args = c(excluded_args, "slot", "ncol")
-        fn = DotPlot
-        default_devpars = function(features, ncol, uidents) {
-            list(
-                height = max(length(uidents) * 80 + 150, 420),
-                width = length(features) * 50 + 150,
-                res = 100
-            )
-        }
-    } else if ("heatmap" %in% case$kind) {
-        case$kind = "heatmap"
-        case = list_update(
-            list(
-                group.colors = pal_ucscgb(alpha = .8)(26),
-                size = 3.5,
-                group.bar.height = 0.01
-            ),
-            case
-        )
-        if (is.null(case$plus)) {
-            case$plus = 'scale_fill_gradientn(colors = c("lightgrey", pal_ucscgb()(1)), na.value = "white")'
-        }
-        excluded_args = c(excluded_args, "group.by", "split.by", "downsample", "ncol")
-        fn = DoHeatmap
-        default_devpars = function(features, ncol, uidents) {
-            list(
-                width = length(uidents) * 60 + 150,
-                height = length(features) * 40 + 150,
-                res = 100
-            )
-        }
-    } else if ("table" %in% case$kind) {
-        case$kind = "table"
-        excluded_args = c(excluded_args, "group.by", "split.by", "assay")
-        case$assays = case$assay
-        fn = AverageExpression
-        if (is.null(case$slot)) {
-            case$slot = "data"
-        }
+    case <- list_update(features_defaults, features[[name]])
+    case <- extract_vars(
+        case,
+        "devpars", "more_formats", "save_code", "save_data", "order_by",
+        "subset", "features", "descr",
+        allow_nonexisting = TRUE)
+
+    if (!is.null(subset)) {
+        case$object <- srtobj %>% filter(!!parse_expr(subset))
     } else {
-        stop("Unknown kind of plot")
+        case$object <- srtobj
     }
 
-    for (arg in excluded_args) {
-        assign(arg, case[[arg]])
-        case[[arg]] = NULL
-    }
+    if (exists("order_by") && !is.null(order_by)) {
+        case$ident <- case$ident %||% GetIdentityColumn(case$object)
+        if (length(order_by) < 2) {
+            clusters <- case$object@meta.data %>%
+                group_by(!!sym(case$ident)) %>%
+                arrange(!!parse_expr(order_by)) %>%
+                ungroup() %>%
+                pull(!!sym(case$ident)) %>%
+                unique()
 
-    if (is.character(subset)) {
-        case$object = srtobj %>% filter(!!rlang::parse_expr(subset))
-    } else {
-        case$object = srtobj
-    }
-    if (!is.null(ident)) {
-        Idents(case$object) = ident
-    }
-    case$features = .get_features(case$features)
-    if (!is.null(case$ncol)) {
-        case$ncol = min(case$ncol, length(case$features))
+            case$object@meta.data[[case$ident]] <- factor(case$object@meta.data[[case$ident]], levels = clusters)
+        } else {
+            case$object@meta.data[[case$ident]] <- fct_relevel(case$object@meta.data[[case$ident]], order_by)
+        }
     }
 
-    toc$kind = kind
-    if (kind == "table") {
-        expr = do_call(fn, case)$RNA %>%
-            as.data.frame() %>%
-            rownames_to_column("Feature") %>%
-            select(Feature, everything())
+    info <- case_info(name, odir, is_dir = FALSE, create = TRUE)
+
+    caching <- Cache$new(
+        c(case, list(devpars, more_formats, save_code, save_data, order_by, subset, features, descr)),
+        prefix = "biopipen.scrna.SeuratClusterStats.features",
+        cache_dir = cache,
+        kind = "prefix",
+        path = info$prefix
+    )
 
-        toc$file = paste0(slugify(name), ".txt")
-        write.table(expr, file.path(odir, toc$file), sep="\t", quote=FALSE, row.names=FALSE)
+    if (caching$is_cached()) {
+        log$info("  plots are cached, restoring ...")
+        caching$restore()
     } else {
-        devpars = list_update(
-            default_devpars(case$features, case$ncol, unique(Idents(case$object))),
-            devpars
-        )
-        if (kind == "heatmap") {
-            if (!exists("downsample") || is.null(downsample)) {
-                downsample = "average"
-            }
-            if (downsample %in% c("average", "mean")) {
-                case$object = AverageExpression(case$object, return.seurat = TRUE)
-            } else if (is.integer(downsample)) {
-                case$object = subset(case$object, downsample = downsample)
-            } else {
-                stop("Unknown downsample method.")
-            }
+        case$features <- .get_features(features, case$object)
+        p <- tryCatch({
+            do_call(gglogger::register(FeatureStatPlot), case)
+        }, error = function(e) {
+            if (save_code) { stop(e) }
+            do_call(FeatureStatPlot, 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)
         }
-        p = do_call(fn, case)
-        if (!is.null(plus)) {
-            for (pls in plus) {
-                p = p + eval(parse(text = pls))
+
+        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)
         }
-        figfile = file.path(odir, paste0(slugify(name), ".", kind, ".png"))
-        toc$file = basename(figfile)
-        png(figfile, width=devpars$width, height=devpars$height, res=devpars$res)
-        tryCatch({
-            print(p)
-        }, error = function(e) {
-            stop(
-                paste(
-                    paste(names(devpars), collapse=" "),
-                    paste(devpars, collapse=" "),
-                    e,
-                    sep = "\n"
+
+        caching$save(info$prefix)
+    }
+    # add reports
+    default_descr <- glue(
+        "The plot shows the distribution or pattern of the specified features ({paste(case$features %||% features, collapse = ', ')}) ",
+        "across cells",
+        "{if (!is.null(case$ident)) glue(', identified by \"{case$ident}\"') else ''}",
+        "{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 plot type is '{case$plot_type}', ",
+        "{if (case$plot_type == 'dim') 'displaying the features on a dimensional reduction embedding' ",
+        " else if (case$plot_type == 'heatmap') 'arranged as a heatmap by rows_name and other grouping variables' ",
+        " else if (case$plot_type %in% c('violin', 'box', 'ridge')) 'showing the distribution of feature values by the grouping variables' ",
+        " else if (case$plot_type == 'cor') 'showing the correlation between features' ",
+        " else 'showing aggregated feature values by the grouping variables'}. ",
+        "{if (!is.null(case$facet_by)) glue('Plots are further faceted by \"{case$facet_by}\". ') else ''}",
+        "{if (case$plot_type == 'dim') glue('The reduction used is \"{if (!is.null(case$reduction)) case$reduction else DefaultDimReduc(case$object)}\"') else ''}",
+        "{if (case$plot_type == 'dim' && !is.null(case$graph)) glue(', with graph \"{case$graph}\" drawn to show cell neighbor edges') else ''}",
+        "{if (case$plot_type == 'dim' && !is.null(case$bg_cutoff) && case$bg_cutoff > 0) glue(', and a background cutoff of {case$bg_cutoff}') else ''}",
+        "{if (case$plot_type == 'dim') glue(', using dimensions {paste(case$dims %||% 1:2, collapse = \",\")}') else ''}"
+    )
+    if (!is.null(case$comparisons)) {
+        default_descr <- paste0(
+            default_descr,
+            glue("Statistical comparisons were performed between groups using \"{case$pairwise_method %||% 'wilcox.test'}\" method.")
+        )
+    }
+    reporter$add2(
+        list(kind = "descr", content = descr %||% default_descr),
+        hs = c(info$section, info$name)
+    )
+
+    if (save_data) {
+        reporter$add2(
+            list(
+                name = "Plot",
+                contents = list(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))
                 )
-            )
-        })
-        dev.off()
+            ),
+            hs = c(info$section, info$name),
+            ui = "tabs"
+        )
+    } else {
+        reporter$add2(
+            reporter$image(info$prefix, more_formats, save_code, kind = "image"),
+            hs = c(info$section, info$name)
+        )
     }
-    .add_toc(if (is.null(section)) name else section, toc)
 }
 
 sapply(names(features), do_one_features)
-.save_toc()

biopipen/scripts/scrna/SeuratClusterStats-ngenes.R

@@ -0,0 +1,81 @@
+# Loaded variables: srtfile, outdir, srtobj
+
+# ngenes_defaults <- {{envs.ngenes_defaults | r: todot="-"}}
+# ngenes <- {{envs.ngenes | r: todot="-", skip=1}}
+log$info("ngenes:")
+
+odir <- file.path(outdir, "ngenes")
+dir.create(odir, recursive=TRUE, showWarnings=FALSE)
+
+do_one_ngenes <- function(name) {
+    log$info("- Case: {name}")
+
+    case <- list_update(ngenes_defaults, ngenes[[name]])
+    case$devpars <- list_update(ngenes_defaults$devpars, case$devpars)
+    case$more_formats <- case$more_formats %||% character(0)
+    case$save_code <- case$save_code %||% FALSE
+    case$descr <- case$descr %||% name
+    case$save_data <- case$save_data %||% FALSE
+    case$ylab <- case$ylab %||% "Number of expressed genes"
+    case$features <- "Number of expressed genes"
+    extract_vars(case, "devpars", "more_formats", "descr", "save_code", "save_data", subset_ = "subset")
+
+    if (!is.null(case$subset)) {
+        case$object <- srtobj %>% filter(!!rlang::parse_expr(subset_))
+    } else {
+        case$object <- srtobj
+    }
+    case$object <- AddMetaData(case$object, Matrix::colSums(GetAssayData(case$object) > 0), col.name = "Number of expressed genes")
+
+    info <- case_info(name, odir, is_dir = FALSE, create = TRUE)
+    p <- do_call(gglogger::register(FeatureStatPlot), case)
+    save_plot(p, info$prefix, case$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 (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),
+                    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),
+            reporter$image(info$prefix, more_formats, save_code, kind = "image"),
+            hs = c(info$section, info$name)
+        )
+    }
+}
+
+sapply(names(ngenes), do_one_ngenes)