biopipen 0.32.1__py3-none-any.whl → 0.33.0__py3-none-any.whl

biopipen/scripts/scrna/SeuratClusterStats-stats.R

@@ -1,251 +1,68 @@
 # Loaded variables: srtfile, outdir, srtobj
 library(circlize)
 
-# stats_defaults = {{envs.stats_defaults | r: todot="-"}}
-# stats = {{envs.stats | r: todot="-", skip=1}}
-log_info("stats:")
+log$info("stats:")
 
-odir = file.path(outdir, "stats")
+odir <- file.path(outdir, "stats")
 dir.create(odir, recursive=TRUE, showWarnings=FALSE)
 
-do_one_stats = function(name) {
-    log_info("- Case: {name}")
+do_one_stats <- function(name) {
+    log$info("- Case: {name}")
 
-    case = list_update(stats_defaults, stats[[name]])
-    case$devpars = list_update(stats_defaults$devpars, case$devpars)
-    case$pie_devpars = list_update(stats_defaults$pie_devpars, case$pie_devpars)
-    case$circos_devpars = list_update(stats_defaults$circos_devpars, case$circos_devpars)
-    if (isTRUE(case$pie) && !is.null(case$group.by)) {
-        stop(paste0(name, ": pie charts are not supported for group-by"))
-    }
-    if (isTRUE(case$transpose) && is.null(case$group.by)) {
-        stop(paste0(name, ": transpose is only supported for group-by"))
-    }
-
-    figfile = file.path(odir, paste0(slugify(name), ".bar.png"))
-    piefile = file.path(odir, paste0(slugify(name), ".pie.png"))
-    circosfile = file.path(odir, paste0(slugify(name), ".circos.png"))
-    samtablefile = file.path(odir, paste0(slugify(name), ".bysample.txt"))
-    tablefile = file.path(odir, paste0(slugify(name), ".txt"))
-
-    df_cells = srtobj@meta.data %>% drop_na(!!sym(case$ident))
-    if (!is.null(case$subset)) {
-        df_cells = df_cells %>% filter(!!rlang::parse_expr(case$subset))
-    }
+    case <- list_update(stats_defaults, stats[[name]])
+    extract_vars(case, "devpars", "more_formats", "save_code", "save_data", "subset")
 
-    select_cols = unique(c(case$ident, case$group.by, case$split.by))
-    if (!is.null(case$split.by)) {
-        plot_df = do_call(rbind, lapply(group_split(
-            df_cells %>% select(all_of(select_cols)),
-            !!!syms(case$split.by)
-        ), function(df) {
-            out <- df %>% group_by(!!!syms(select_cols)) %>% summarise(.n = n(), .groups = "drop")
-            if (!is.null(case$group.by) && case$frac != "none") {
-                if (case$frac == "all") {
-                    out <- out %>% mutate(.frac = .n / sum(.n))
-                } else if (case$frac == "group") {
-                    out <- out %>% group_by(!!sym(case$group.by)) %>% mutate(.frac = .n / sum(.n))
-                } else {  # case$frac == "ident" or "cluster"
-                    out <- out %>% group_by(!!sym(case$ident)) %>% mutate(.frac = .n / sum(.n))
-                }
-            }
-            out
-        }))
-    } else if (!is.null(case$group.by) && case$frac != "none") {  # no split.by
-        plot_df <- df_cells %>%
-            select(all_of(select_cols)) %>%
-            group_by(!!!syms(select_cols)) %>%
-            summarise(.n = n(), .groups = "drop")
-        if (case$frac == "all") {
-            plot_df = plot_df %>% mutate(.frac = .n / sum(.n))
-        } else if (case$frac == "group") {
-            plot_df = plot_df %>% group_by(!!sym(case$group.by)) %>% mutate(.frac = .n / sum(.n))
-        } else {  # case$frac == "ident" or "cluster"
-            plot_df = plot_df %>% group_by(!!sym(case$ident)) %>% mutate(.frac = .n / sum(.n))
-        }
+    if (!is.null(subset)) {
+        case$object <- srtobj %>% filter(!!parse_expr(subset))
     } else {
-        plot_df <- df_cells %>%
-            select(all_of(select_cols)) %>%
-            group_by(!!!syms(select_cols)) %>%
-            summarise(.n = n(), .groups = "drop")
-
-        if (case$frac != "none") {
-            plot_df <- plot_df %>% mutate(.frac = .n / sum(.n))
-        }
+        case$object <- srtobj
     }
 
-    write.table(plot_df, tablefile, sep="\t", quote=FALSE, row.names=FALSE)
-
-    ngroups = ifelse(is.null(case$group.by), 1, length(unique(plot_df[[case$group.by]])))
-    nidents = length(unique(plot_df[[case$ident]]))
-    bar_position = ifelse(case$position == "auto", ifelse(ngroups > 5, "stack", "dodge"), case$position)
-    p = plot_df %>%
-        ggplot(aes(
-            x=!!sym(ifelse(case$transpose, case$group.by, case$ident)),
-            y=if (case$frac != "none") .frac else .n,
-            fill=!!sym(ifelse(is.null(case$group.by) || isTRUE(case$transpose), case$ident, case$group.by))
-        )) +
-        geom_bar(stat="identity", position=bar_position, alpha=.8) +
-        theme_prism(axis_text_angle = 90) +
-        scale_fill_biopipen() +
-        ylab(ifelse(case$frac != "none", "Fraction of cells", "Number of cells"))
-
-    if (!is.null(case$split.by)) {
-        p = p + facet_wrap(case$split.by)
-    }
-
-    png(figfile, width=case$devpars$width, height=case$devpars$height, res=case$devpars$res)
-    print(p)
-    dev.off()
-
-    add_report(
-        list(
-            kind = "descr",
-            content = paste0(
-                "Plots showing the ",
-                ifelse(case$frac != "none", "number/faction", "number"),
-                " of cells per cluster",
-                ifelse(
-                    is.null(case$group.by),
-                    "",
-                    paste0(", by ", paste0(case$group.by, collapse = ", "))
-                )
-            )
-        ),
-        h1 = name
-    )
-
-    add_report(
-        list(
-            name = "Bar Plot",
-            contents = list(list(kind = "image", src = figfile))
-        ),
-        h1 = name,
-        ui = "tabs"
-    )
-    if (isTRUE(case$table)) {
-        add_report(
-            list(
-                name = "Table",
-                contents = list(list(kind = "table", src = tablefile))
-            ),
-            h1 = name,
-            ui = "tabs"
-        )
+    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'))"),
+            "case",
+            auto_data_setup = FALSE)
     }
 
-    if (isTRUE(case$pie)) {
-        p_pie = plot_df %>%
-            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_biopipen() +
-            guides(fill = guide_legend(title = case$ident)) +
-            theme_void() +
-            geom_label(
-                if (case$frac != "none")
-                    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)
+    if (save_data) {
+        if (!inherits(p$data, "data.frame") && !inherits(p$data, "matrix")) {
+            stop("'save_data = TRUE' is not supported for plot_type: ", case$plot_type)
         }
-
-        png(piefile, width=case$pie_devpars$width, height=case$pie_devpars$height, res=case$pie_devpars$res)
-        print(p_pie)
-        dev.off()
-
-        add_report(
+        write.table(p$data, paste0(info$prefix, ".data.txt"), sep="\t", quote=FALSE, row.names=FALSE)
+        reporter$add2(
             list(
-                name = "Pie Chart",
-                contents = list(list(kind = "image", src = piefile))
+                name = "Plot",
+                contents = list(
+                    reporter$image(
+                        info$prefix, more_formats, save_code, kind = "image")
+                )
             ),
-            h1 = name,
-            ui = "tabs"
-        )
-    }
-
-    if (isTRUE(case$circos)) {
-        if (is.null(case$group.by)) {
-            stop(paste0(name, ": circos plots require a group-by"))
-        }
-        if (isTRUE(case$transpose)) {
-            circos_df <- plot_df %>%
-                select(from=!!sym(case$ident), to=!!sym(case$group.by), value=.n)
-        } else {
-            circos_df <- plot_df %>%
-                select(from=!!sym(case$group.by), to=!!sym(case$ident), value=.n)
-        }
-        groups <- if (is.factor(circos_df$from)) {
-            levels(circos_df$from)
-        } else {
-            unique(circos_df$from)
-        }
-        idents <- if (is.factor(circos_df$to)) {
-            levels(circos_df$to)
-        } else {
-            unique(circos_df$to)
-        }
-        grid_cols <- pal_biopipen()(length(idents))
-        names(grid_cols) <- idents
-        gcols <- rep("#565656", length(groups))
-        names(gcols) <- groups
-        grid_cols <- c(grid_cols, gcols)
-        link_cols <- grid_cols[circos_df$to]
-
-        png(
-            circosfile,
-            width=case$circos_devpars$width,
-            height=case$circos_devpars$height,
-            res=case$circos_devpars$res
-        )
-        circos.clear()
-        if (!isTRUE(case$circos_labels_rot)) {
-            chordDiagram(
-                circos_df,
-                grid.col = grid_cols,
-                col = link_cols,
-                direction = 1,
-                direction.type = c("diffHeight", "arrows"),
-                link.arr.type = "big.arrow"
-            )
-        } else {
-            chordDiagram(
-                circos_df,
-                grid.col = grid_cols,
-                col = link_cols,
-                direction = 1,
-                annotationTrack = "grid",
-                direction.type = c("diffHeight", "arrows"),
-                link.arr.type = "big.arrow",
-                preAllocateTracks = list(track.height = max(strwidth(unlist(dimnames(circos_df)))))
-            )
-            circos.track(track.index = 1, panel.fun = function(x, y) {
-                circos.text(
-                    CELL_META$xcenter, CELL_META$ylim[1],
-                    CELL_META$sector.index,
-                    facing = "clockwise",
-                    niceFacing = TRUE,
-                    adj = c(0, 0.5))
-            }, bg.border = NA) # here set bg.border to NA is important
-        }
-        dev.off()
-
-        add_report(
             list(
-                name = "Circos plot",
-                contents = list(list(kind = "image", src = circosfile))
+                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)
+                    )
+                )
             ),
-            h1 = name,
+            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)
+        )
     }
 }
 

biopipen/scripts/scrna/SeuratClusterStats.R

@@ -1,35 +1,34 @@
-{{ biopipen_dir | joinpaths: "utils", "misc.R" | source_r }}
-{{ biopipen_dir | joinpaths: "utils", "mutate_helpers.R" | source_r }}
-{{ biopipen_dir | joinpaths: "utils", "plot.R" | source_r }}
-
 library(Seurat)
 library(rlang)
 library(dplyr)
 library(tidyr)
 library(tibble)
-library(ggprism)
-library(ggrepel)
+library(forcats)
 library(tidyseurat)
-library(circlize)
-library(ComplexHeatmap)
+library(gglogger)
+library(scplotter)
+library(biopipen.utils)
+
+log <- get_logger()
+reporter <- get_reporter()
 
 srtfile <- {{in.srtobj | r}}
 outdir <- {{out.outdir | r}}
 joboutdir <- {{job.outdir | r}}
 mutaters <- {{envs.mutaters | r}}
 
-log_info("Loading Seurat object ...")
+log$info("Loading Seurat object ...")
 srtobj = readRDS(srtfile)
 
-log_info("Applying mutaters if any ...")
+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}}
-clustrees <- {{envs.clustrees | r}}
+clustrees_defaults <- {{envs.clustrees_defaults | r: todot="-"}}
+clustrees <- {{envs.clustrees | r: todot="-", skip=1}}
 {{ biopipen_dir | joinpaths: "scripts", "scrna", "SeuratClusterStats-clustree.R" | source_r }}
 
 ############## stats ##############
@@ -37,11 +36,6 @@ stats_defaults = {{envs.stats_defaults | r: todot="-"}}
 stats = {{envs.stats | r: todot="-", skip=1}}
 {{ biopipen_dir | joinpaths: "scripts", "scrna", "SeuratClusterStats-stats.R" | source_r }}
 
-############## hists ##############
-hists_defaults <- {{envs.hists_defaults | r: todot="-"}}
-hists <- {{envs.hists | r: todot="-", skip=1}}
-{{ biopipen_dir | joinpaths: "scripts", "scrna", "SeuratClusterStats-hists.R" | source_r }}
-
 ############## ngenes ##############
 ngenes_defaults <- {{envs.ngenes_defaults | r: todot="-"}}
 ngenes <- {{envs.ngenes | r: todot="-", skip=1}}
@@ -50,11 +44,11 @@ ngenes <- {{envs.ngenes | r: todot="-", skip=1}}
 ############## features ##############
 features_defaults = {{envs.features_defaults | r: todot="-"}}
 features = {{envs.features | r: todot="-", skip=1}}
-{{ biopipen_dir | joinpaths: "scripts", "scrna", "SeuratClusterStats-features.R" | source_r }}
+{{ biopipen_dir | joinpaths: "scripts", "scrna", "SeuratClusterStats-features.R" | source_r: chdir = False }}
 
 ############## dimplots ##############
 dimplots_defaults = {{envs.dimplots_defaults | r: todot="-"}}
 dimplots = {{envs.dimplots | r: todot="-", skip=1}}
 {{ biopipen_dir | joinpaths: "scripts", "scrna", "SeuratClusterStats-dimplots.R" | source_r }}
 
-save_report(joboutdir)
+reporter$save(joboutdir)

biopipen/scripts/scrna/SeuratMap2Ref.R

@@ -6,8 +6,11 @@ library(SeuratDisk)
 library(rlang)
 library(dplyr)
 library(tidyr)
+library(ggplot2)
+library(ggprism)
 
 set.seed(8525)
+theme_set(theme_prism())
 
 sobjfile = {{in.sobjfile | r}}
 outfile = {{out.outfile | r}}
@@ -346,8 +349,16 @@ saveRDS(sobj, file = outfile)
 # ############################
 # Some plots
 # ############################
+log_info("- Plotting mapping score ...")
+p <- FeaturePlot(
+    object = sobj,
+    reduction = "ref.umap",
+    features = "mapping.score",
+    cols = c("white", "blue"),
+    pt.size = 0.5
+) + ggtitle("Mapping score for query cells")
+save_plot(p, file.path(outdir, "mapping_score"), list(width = 800, height = 600, res = 100))
 
-# # Plot the UMAP
 log_info("- Plotting for transferred data ...")
 ref.reduction = mapquery_args$reduction.model %||% "wnn.umap"
 for (qname in names(mapquery_args$refdata)) {
@@ -358,8 +369,7 @@ for (qname in names(mapquery_args$refdata)) {
         next
     }
 
-    log_info("  Plotting transferred data: {qname} -> {rname}")
-
+    log_info("  UMAP for transferred data: {qname} -> {rname}")
     ref_p <- DimPlot(
         object = reference,
         reduction = ref.reduction,
@@ -378,9 +388,9 @@ for (qname in names(mapquery_args$refdata)) {
         repel = TRUE,
     ) + NoLegend()
 
-    png(file.path(outdir, paste0("UMAPs-", slugify(qname), ".png")), width = 1500, height = 700, res = 100)
-    print(ref_p | query_p)
-    dev.off()
+    p <- ref_p | query_p
+    prefix <- file.path(outdir, paste0("UMAPs-", slugify(qname)))
+    save_plot(p, prefix, list(width = 1500, height = 700, res = 100))
 
     # summarize the stats
     log_info("  Summarizing stats: {qname} -> {rname}")