biopipen 0.17.7__py3-none-any.whl → 0.18.0__py3-none-any.whl

biopipen/scripts/delim/SampleInfo.R

@@ -5,6 +5,7 @@ library(dplyr)
 library(ggplot2)
 library(ggprism)
 library(ggsci)
+library(ggrepel)
 
 infile <- {{in.infile | r}}
 outfile <- {{out.outfile | r}}
@@ -39,8 +40,9 @@ for (name in names(stats)) {
     plotfile <- file.path(outdir, paste0(name, ".png"))
 
     is_continuous <- FALSE
-    if (startsWith(stat$on, "distinct:")) {
-        stat$on <- substring(stat$on, 10)
+    if (startsWith(stat$on, "distinct:") || startsWith(stat$on, "unique:")) {
+        stat$on <- gsub("distinct:", "", stat$on)
+        stat$on <- gsub("unique:", "", stat$on)
         data <- mutdata %>% distinct(!!sym(stat$on), .keep_all = TRUE)
     } else {
         data <- mutdata
@@ -89,14 +91,14 @@ for (name in names(stats)) {
     if (stat$plot == "boxplot" || stat$plot == "box") {
         p <- ggplot(data, aes(x=!!group, y=!!sym(stat$on), fill=!!group)) +
             geom_boxplot(position = "dodge") +
-            scale_fill_ucscgb() +
+            scale_fill_ucscgb(alpha = .8) +
             xlab("")
     } else if (stat$plot == "violin" ||
                stat$plot == "violinplot" ||
                stat$plot == "vlnplot") {
         p <- ggplot(data, aes(x = !!group, y = !!sym(stat$on), fill=!!group)) +
             geom_violin(position = "dodge") +
-            scale_fill_ucscgb() +
+            scale_fill_ucscgb(alpha = .8) +
             xlab("")
     } else if (
         (grepl("violin", stat$plot) || grepl("vln", stat$plot)) &&
@@ -105,12 +107,12 @@ for (name in names(stats)) {
         p <- ggplot(data, aes(x = !!group, y = !!sym(stat$on), fill = !!group)) +
             geom_violin(position = "dodge") +
             geom_boxplot(width = 0.1, position = position_dodge(0.9), fill="white") +
-            scale_fill_ucscgb() +
+            scale_fill_ucscgb(alpha = .8) +
             xlab("")
     } else if (stat$plot == "histogram" || stat$plot == "hist") {
         p <- ggplot(data, aes(x = !!sym(stat$on), fill = !!group)) +
             geom_histogram(bins = 10, position = "dodge", alpha = 0.8, color = "white") +
-            scale_fill_ucscgb()
+            scale_fill_ucscgb(alpha = .8)
     } else if (stat$plot == "pie" || stat$plot == "piechart") {
         if (is.null(stat$each)) {
             data <- data %>% distinct(!!group, .keep_all = TRUE)
@@ -120,19 +122,20 @@ for (name in names(stats)) {
                 group_by(!!sym(stat$each))
         }
         p <- ggplot(
-            data %>%
-                mutate(
-                    ..prop = !!sym(count_on) / sum(!!sym(count_on)),
-                    ..ypos = (cumsum(..prop) - 0.5 * ..prop) * sum(!!sym(count_on))
-                ),
-            aes(x = "", y = !!sym(count_on), fill = !!group)
+            data %>% arrange(!!group),
+            aes(x = "", y = !!sym(count_on), fill = rev(!!group), label = !!sym(count_on))
         ) +
             geom_bar(stat="identity", width=1, color="white") +
             coord_polar("y", start = 0) +
             theme_void() +
             theme(plot.title = element_text(hjust = 0.5)) +
-            geom_text(aes(y = ..ypos, label = !!sym(count_on))) +
-            scale_fill_ucscgb() +
+            geom_label_repel(
+                position = position_stack(vjust = 0.5),
+                color="#333333",
+                fill="#EEEEEE",
+                size=4
+            ) +
+            scale_fill_ucscgb(alpha = .8, name = group) +
             ggtitle(paste0("# ", stat$on))
     } else if (stat$plot == "bar" || stat$plot == "barplot") {
         if (is.null(stat$each)) {
@@ -144,7 +147,7 @@ for (name in names(stats)) {
             data,
             aes(x = !!group, y = !!sym(count_on), fill = !!group)) +
             geom_bar(stat = "identity") +
-            scale_fill_ucscgb() +
+            scale_fill_ucscgb(alpha = .8) +
             ylab(paste0("# ", stat$on))
     } else {
         stop("Unknown plot type: ", stat$plot)

biopipen/scripts/scrna/MarkersFinder.R

@@ -8,6 +8,8 @@ library(tibble)
 library(Seurat)
 library(enrichR)
 library(ggplot2)
+library(ggprism)
+library(ggrepel)
 library(future)
 library(tidyseurat)
 
@@ -25,9 +27,14 @@ prefix_each <- {{ envs.prefix_each | r }}
 section <- {{ envs.section | r }}
 dbs <- {{ envs.dbs | r }}
 sigmarkers <- {{ envs.sigmarkers | r }}
+volcano_genes <- {{ envs.volcano_genes | r }}
 rest <- {{ envs.rest | r: todot="-" }}
 cases <- {{ envs.cases | r: todot="-" }}
 
+if (is.character(volcano_genes) && length(volcano_genes) == 1) {
+    volcano_genes <- trimws(strsplit(volcano_genes, ",")[[1]])
+}
+
 set.seed(8525)
 if (ncores > 1) {
     options(future.globals.maxSize = 80000 * 1024^2)
@@ -55,6 +62,7 @@ if (is.null(cases) || length(cases) == 0) {
             section = section,
             dbs = dbs,
             sigmarkers = sigmarkers,
+            volcano_genes = volcano_genes,
             rest = rest
         )
     )
@@ -70,6 +78,7 @@ if (is.null(cases) || length(cases) == 0) {
             section = section,
             dbs = dbs,
             sigmarkers = sigmarkers,
+            volcano_genes = volcano_genes,
             rest = rest
         )
         case$rest <- list_setdefault(case$rest, rest)
@@ -153,13 +162,59 @@ for (name in names(cases)) {
 }
 cases <- newcases
 
+plot_volcano = function(markers, volfile, sig, volgenes) {
+    # markers
+    #                  gene        p_val avg_log2FC pct.1 pct.2    p_val_adj
+    # 1            CCL5 1.883596e-11 -4.8282535 0.359 0.927 4.332270e-09
+    # 2        HLA-DQB1 3.667713e-09  6.1543174 0.718 0.098 8.435740e-07
+    # 3        HLA-DRB5 1.242993e-07  3.9032231 0.744 0.195 2.858885e-05
+    # 4           CD79B 2.036731e-07  4.2748835 0.692 0.146 4.684482e-05
+    markers = markers %>%
+        mutate(
+            Significant = if_else(
+                !!parse_expr(sig),
+                if_else(avg_log2FC > 0, "Up", "Down"),
+                "No"
+            ),
+            Label = if_else(
+                Significant != "No" & (isTRUE(volgenes) | (gene %in% volgenes)),
+                gene,
+                ""
+            )
+        )
+
+    p_vol = ggplot(markers, aes(x = avg_log2FC, y = -log10(p_val_adj))) +
+        geom_point(aes(color = Significant), alpha = 0.75) +
+        scale_color_manual(
+            values = c(Up = "#FF3333", Down = "#3333FF", No = "#AAAAAA"),
+            labels = c(Up = "Up", Down = "Down", No = "Non-Significant")
+        ) +
+        geom_text_repel(
+            aes(label = Label),
+            size = 3,
+            color = "#000000",
+            box.padding = unit(0.35, "lines"),
+            point.padding = unit(0.5, "lines"),
+            segment.color = "#000000"
+        ) +
+        theme_prism() +
+        theme(legend.title=element_blank()) +
+        labs(
+            x = "log2 Fold Change",
+            y = "-log10 Adjusted P-value"
+        )
+
+    png(volfile, res = 100, height = 800, width = 900)
+    print(p_vol)
+    dev.off()
+}
 
 # Do enrichment analysis for a case using Enrichr
 # Args:
 #   case: case name
 #   markers: markers dataframe
 #   sig: The expression to filter significant markers
-do_enrich <- function(case, markers, sig) {
+do_enrich <- function(case, markers, sig, volgenes) {
     print(paste("  Running enrichment for case:", case))
     parts <- strsplit(case, ":")[[1]]
     sec <- parts[1]
@@ -171,6 +226,7 @@ do_enrich <- function(case, markers, sig) {
         cat("No markers found.", file = file.path(casedir, "error.txt"))
         return()
     }
+    plot_volcano(markers, file.path(casedir, "volcano.png"), sig, volgenes)
     markers_sig <- markers %>% filter(!!parse_expr(sig))
     if (nrow(markers_sig) == 0) {
         print(paste("  No significant markers found for case:", case))
@@ -255,7 +311,7 @@ do_case <- function(casename) {
         args$object <- srtobj
     }
     markers <- do_call(FindMarkers, args) %>% rownames_to_column("gene")
-    do_enrich(casename, markers, case$sigmarkers)
+    do_enrich(casename, markers, case$sigmarkers, case$volcano_genes)
 }
 
 sapply(sort(names(cases)), do_case)

biopipen/scripts/scrna/SeuratClusterStats-dimplots.R

@@ -0,0 +1,40 @@
+# Loaded variables: srtfile, outdir, srtobj
+
+dimplots_defaults = {{envs.dimplots_defaults | r: todot="-"}}
+dimplots = {{envs.dimplots | r: todot="-", skip=1}}
+
+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))
+
+    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)
+    }
+
+    excluded_args = c("devpars", "ident")
+    for (arg in excluded_args) {
+        assign(arg, case[[arg]])
+        case[[arg]] = NULL
+    }
+
+    if (case$reduction %in% c("dim", "auto")) {
+        case$reduction = NULL
+    }
+    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()
+}
+
+sapply(names(dimplots), do_one_dimplot)
+.save_toc()

biopipen/scripts/scrna/SeuratClusterStats-features.R

@@ -0,0 +1,236 @@
+# Loaded variables: srtfile, outdir, srtobj
+
+features_defaults = {{envs.features_defaults | r: todot="-"}}
+features = {{envs.features | r: todot="-", skip=1}}
+
+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]])] <<- toc
+    } else {
+        report_toc[[section]] <<- list(toc)
+    }
+}
+
+.get_features = function(features) {
+    if (is.null(features)) { features = 20 }
+    if (is.numeric(features)) {
+        return (VariableFeatures(srtobj)[1:features])
+    }
+    if (is.character(features) && length(features) > 1) {
+        return (features)
+    }
+    if (is.character(features) && startsWith(features, "file://")) {
+        return (read.table(
+            substring(features, 8),
+            header = FALSE,
+            row.names = NULL,
+            check.names = FALSE
+        )$V1)
+    }
+
+    if (is.null(features)) {
+        if (is.null(default_features)) {
+            return (default[1:20])
+        } else {
+            return (default_features)
+        }
+    }
+
+    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"
+    )
+
+    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"
+        }
+    } else {
+        stop("Unknown kind of plot")
+    }
+
+    for (arg in excluded_args) {
+        assign(arg, case[[arg]])
+        case[[arg]] = NULL
+    }
+
+    if (is.character(subset)) {
+        case$object = srtobj %>% tidyseurat::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))
+    }
+
+    toc$kind = kind
+    if (kind == "table") {
+        expr = do_call(fn, case)$RNA %>%
+            as.data.frame() %>%
+            rownames_to_column("Feature") %>%
+            select(Feature, everything())
+
+        toc$file = paste0(slugify(name), ".txt")
+        write.table(expr, file.path(odir, toc$file), sep="\t", quote=FALSE, row.names=FALSE)
+    } 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.")
+            }
+        }
+        p = do_call(fn, case)
+        if (!is.null(plus)) {
+            for (pls in plus) {
+                p = p + eval(parse(text = pls))
+            }
+        }
+        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"
+                )
+            )
+        })
+        dev.off()
+    }
+    .add_toc(if (is.null(section)) name else section, toc)
+}
+
+sapply(names(features), do_one_features)
+.save_toc()

biopipen/scripts/scrna/SeuratClusterStats-stats.R

@@ -0,0 +1,105 @@
+# Loaded variables: srtfile, outdir, srtobj
+
+stats_defaults = {{envs.stats_defaults | r: todot="-"}}
+stats = {{envs.stats | r: todot="-", skip=1}}
+
+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))
+
+    toc = list()
+
+    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("pie charts are not supported for group-by")
+    }
+
+    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))
+    }
+
+    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)
+    }
+    if (isTRUE(case$pie)) {
+        p_pie = df_cells %>%
+            arrange(!!sym(case$ident)) %>%
+            ggplot(aes(x="", y=.n, fill=rev(!!sym(case$ident)))) +
+            geom_bar(stat="identity", width=1, alpha=.8) +
+            coord_polar("y", start=0) +
+            guides(fill = guide_legend(reverse = TRUE, title = NULL)) +
+            theme_void() +
+            geom_label_repel(
+                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
+            ) +
+            scale_fill_ucscgb(alpha=.8)
+
+        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()
+    }
+
+    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)
+    }
+
+    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()