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

biopipen/scripts/scrna/RadarPlots.R

@@ -1,3 +1,6 @@
+{{ biopipen_dir | joinpaths: "utils", "misc.R" | source_r }}
+{{ biopipen_dir | joinpaths: "utils", "repr.R" | source_r }}
+
 library(Seurat)
 library(rlang)
 library(dplyr)
@@ -5,28 +8,97 @@ library(tidyr)
 library(tibble)
 library(ggplot2)
 library(ggradar)
+library(ggprism)
+library(glue)
+library(gglogger)
 
 # input/output
 srtfile = {{in.srtobj | r}}
 outdir = {{out.outdir | r}}
+joboutdir = {{job.outdir | r}}
 
 # envs
 mutaters = {{envs.mutaters | r}}
 by = {{envs.by | r}}
 each = {{envs.each | r}}
+prefix_each = {{envs.prefix_each | r}}
 order = {{envs.order | r}}
-cluster_col = {{envs.cluster_col | r}}
+colors = {{envs.colors | r}}
+ident = {{envs.ident | r}}
 cluster_order = {{envs.cluster_order | r}}
 breaks = {{envs.breaks | r}}
+breakdown = {{envs.breakdown | r}}
+test = {{envs.test | r}}
 direction = {{envs.direction | r}}
 section = {{envs.section | r}}
+subset_ = {{envs.subset | r}}
+bar_devpars = {{envs.bar_devpars | r}}
 devpars = {{envs.devpars | r}}
 cases = {{envs.cases | r}}
 
-DEFAULT_CASE = "DEFAULT"
+# DEFAULT_CASE = "DEFAULT"
+# sections = c()
+
+log_info("- Reading srtobj ...")
+srtobj = biopipen.utils::read_obj(srtfile)
+meta = srtobj@meta.data
+
+log_info("- Mutating meta data if needed ...")
+if (is.list(mutaters) && length(mutaters) > 0) {
+    mutaters <- lapply(mutaters, function(x) parse_expr(x))
+    meta <- meta %>% mutate(!!!mutaters)
+}
 
-# Used for saving sections
-sections = list()
+defaults <- list(
+    by = by,
+    each = each,
+    prefix_each = prefix_each,
+    order = order,
+    colors = colors,
+    ident = ident,
+    cluster_order = cluster_order,
+    breaks = breaks,
+    breakdown = breakdown,
+    test = test,
+    direction = direction,
+    section = section,
+    subset = subset_,
+    bar_devpars = bar_devpars,
+    devpars = devpars
+)
+
+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
+        }
+    } else {
+        if (is.null(case$subset)) {
+            eachs <- meta %>%
+                pull(case$each) %>% unique() %>% na.omit() %>% as.vector()
+        } else {
+            eachs <- meta %>% filter(!!parse_expr(case$subset)) %>%
+                pull(case$each) %>% unique() %>% na.omit() %>% as.vector()
+        }
+        for (each in eachs) {
+            if (isTRUE(case$prefix_each)) {
+                key <- paste0(name, "::", case$each, " - ", each)
+            } else {
+                key <- paste0(name, "::", each)
+            }
+            outcases[[key]] <- case
+            outcases[[key]]$section <- name
+            outcases[[key]]$each_value <- each
+        }
+    }
+    outcases
+}
+
+log_info("- Expanding cases ...")
+cases <- expand_cases(cases, defaults, expand_each)
 
 auto_breaks = function(maxval) {
     if (maxval <= 0.1) {  # 10%
@@ -52,24 +124,13 @@ auto_breaks = function(maxval) {
     }
 }
 
-run_one_case = function(casename) {
-    case = newcases[[casename]]
-    print(paste("- Running for case:", casename))
-
-    # Save the section
-    if (is.character(case$section) && nchar(case$section) > 0) {
-        sections[[case$section]] <<- c(sections[[case$section]], casename)
-    }
-
-    # Get the counts
-    counts = if (!is.null(case$each)) meta %>% filter(!!sym(case$each) == case$each_value) else meta
-    counts = counts %>%
-        filter(!is.na(!!sym(case$by))) %>%
-        group_by(!!sym(case$cluster_col), !!sym(case$by)) %>%
+do_radarplot <- function(info, case, counts) {
+    rdr_data = counts %>%
+        group_by(!!sym(case$ident), !!sym(case$by)) %>%
         count() %>%
         pivot_wider(
             id_cols = case$by,
-            names_from = !!sym(case$cluster_col),
+            names_from = !!sym(case$ident),
             values_from = n,
             values_fill = 0
         ) %>%
@@ -81,25 +142,26 @@ run_one_case = function(casename) {
 
     # Reorder the clusters if needed
     if (!is.null(case$cluster_order) && length(case$cluster_order) > 0) {
-        counts = counts[, case$cluster_order]
+        rdr_data = rdr_data[, case$cluster_order]
     }
 
     # If clusters are numbers, add a prefix "Cluster"
-    if (all(grepl("^\\d+$", colnames(counts)))) {
-        colnames(counts) = paste0("Cluster", colnames(counts))
+    if (all(grepl("^\\d+$", colnames(rdr_data)))) {
+        colnames(rdr_data) = paste0("Cluster", colnames(rdr_data))
     }
 
     if (!is.null(case$order) && length(case$order) > 0) {
-        counts = counts[case$order, ]
-        if (nrow(counts) == 0) {
+        rdr_data = rdr_data[case$order, ]
+        if (nrow(rdr_data) == 0) {
             stop("No data after reordering. Are items in `order` correct?")
         }
     }
 
     # Save the counts
+    counts_file = file.path(info$casedir, "counts.tsv")
     write.table(
-        counts,
-        file.path(outdir, paste0(casename, ".counts.tsv")),
+        t(rdr_data),
+        counts_file,
         sep = "\t",
         quote = FALSE,
         col.names = TRUE,
@@ -107,17 +169,18 @@ run_one_case = function(casename) {
     )
 
     # Calculate the percentage
-    counts = as.matrix(counts)
+    rdr_data = as.matrix(rdr_data)
     if (case$direction == "inter-cluster") {
-        counts = t(t(counts) / rowSums(t(counts)))
+        rdr_data = t(t(rdr_data) / rowSums(t(rdr_data)))
     } else {
-        counts = counts / rowSums(counts)
+        rdr_data = rdr_data / rowSums(rdr_data)
     }
 
     # Save the percentages
+    perc_file = file.path(info$casedir, "percentages.tsv")
     write.table(
-        counts,
-        file.path(outdir, paste0(casename, ".percentages.tsv")),
+        t(rdr_data),
+        perc_file,
         sep = "\t",
         quote = FALSE,
         col.names = TRUE,
@@ -126,132 +189,290 @@ run_one_case = function(casename) {
 
     # Get the breaks
     breaks = if (is.null(case$breaks) || length(case$breaks) == 0) {
-        auto_breaks(max(counts))
+        auto_breaks(max(rdr_data))
     } else {
         case$breaks
     }
 
     # Plot
+    if (!is.null(case$colors) && length(case$colors) == 1 && case$colors == "biopipen") {
+        colors = pal_biopipen()(nrow(rdr_data))
+    } else if (!is.null(case$colors) && length(case$colors) > 0) {
+        colors = trimws(unlist(strsplit(case$colors, ",")))
+    }
+
+    plotdf <- rdr_data %>%
+        as.data.frame() %>%
+        rownames_to_column("group") %>%
+        mutate(group = factor(group, levels = rownames(rdr_data)))
+
     p = ggradar(
-        counts %>% as.data.frame() %>% rownames_to_column("group"),
+        plotdf,
         values.radar = paste0(breaks, "%"),
         grid.min = breaks[1] / 100,
         grid.mid = breaks[2] / 100,
         grid.max = breaks[3] / 100,
-        plot.title = casename
+        group.colours = colors
     )
-    png(
-        file.path(outdir, paste0(casename, ".png")),
-        width = case$devpars$width,
-        height = case$devpars$height,
-        res = case$devpars$res
+    prefix <- file.path(info$casedir, "plot")
+    save_plot(p, prefix, case$devpars)
+
+    code_file <- paste0(prefix, ".R")
+    code = glue(
+        "library(ggradar)
+
+        plotdf <- {repr(plotdf)}
+        breaks <- {repr(breaks)}
+        colors <- {repr(colors)}
+
+        ggradar(
+            plotdf,
+            values.radar = paste0(breaks, '%'),
+            grid.min = breaks[1] / 100,
+            grid.mid = breaks[2] / 100,
+            grid.max = breaks[3] / 100,
+            group.colours = colors
+        )"
     )
-    print(p)
-    dev.off()
+    writeLines(code, code_file)
 }
 
-# fill up the cases
-if (length(cases) == 0) {
-    cases[[DEFAULT_CASE]] = list(
-        by = by,
-        each = each,
-        order = order,
-        cluster_col = cluster_col,
-        cluster_order = cluster_order,
-        breaks = breaks,
-        direction = direction,
-        section = section,
-        devpars = devpars
+do_barplot_and_tests <- function(info, case, counts) {
+    bardata <- counts %>%
+        group_by(!!sym(case$by), !!sym(case$breakdown), !!sym(case$ident)) %>%
+        summarise(.n = n(), .groups = "drop")
+
+    write.table(
+        bardata,
+        file.path(info$casedir, "breakdown-counts.txt"),
+        sep = "\t",
+        quote = FALSE,
+        col.names = TRUE,
+        row.names = FALSE
     )
-} else {
-    # Use the values given directly under `envs` as default
-    for (key in names(cases)) {
-        if (is.null(cases[[key]]$by)) {
-            cases[[key]]$by = by
-        }
-        if (is.null(cases[[key]]$each)) {
-            cases[[key]]$each = each
-        }
-        if (is.null(cases[[key]]$order)) {
-            cases[[key]]$order = order
-        }
-        if (is.null(cases[[key]]$cluster_col)) {
-            cases[[key]]$cluster_col = cluster_col
-        }
-        if (is.null(cases[[key]]$cluster_order)) {
-            cases[[key]]$cluster_order = cluster_order
-        }
-        if (is.null(cases[[key]]$breaks)) {
-            cases[[key]]$breaks = breaks
-        }
-        if (is.null(cases[[key]]$direction)) {
-            cases[[key]]$direction = direction
-        }
-        if (is.null(cases[[key]]$section)) {
-            cases[[key]]$section = section
-        }
-        if (is.null(cases[[key]]$devpars)) {
-            cases[[key]]$devpars = devpars
-        }
-        if (is.null(cases[[key]]$devpars$width)) {
-            cases[[key]]$devpars$width = devpars$width
-        }
-        if (is.null(cases[[key]]$devpars$height)) {
-            cases[[key]]$devpars$height = devpars$height
-        }
-        if (is.null(cases[[key]]$devpars$res)) {
-            cases[[key]]$devpars$res = devpars$res
-        }
+    if (case$direction == "inter-cluster") {
+        bardata <- bardata %>%
+            group_by(!!sym(case$ident)) %>%
+            mutate(.frac = .n / sum(.n)) %>%
+            ungroup()
+    } else {
+        bardata <- bardata %>%
+            group_by(!!sym(case$by), !!sym(case$breakdown)) %>%
+            mutate(.frac = .n / sum(.n)) %>%
+            ungroup()
     }
-}
 
-print("- Reading srtobj ...")
-srtobj = readRDS(srtfile)
-meta = srtobj@meta.data
+    # Save the percentages
+    write.table(
+        bardata,
+        file.path(info$casedir, "breakdown-percentages.txt"),
+        sep = "\t",
+        quote = FALSE,
+        col.names = TRUE,
+        row.names = FALSE
+    )
 
-print("- Mutating meta data if needed ...")
-if (is.list(mutaters) && length(mutaters) > 0) {
-    mutaters = lapply(mutaters, function(x) parse_expr(x))
-    meta = meta %>% mutate(!!!mutaters)
+    # Reorder the clusters if needed
+    if (!is.null(case$cluster_order) && length(case$cluster_order) > 0) {
+        bardata <- bardata %>%
+            mutate(!!sym(case$ident) := factor(!!sym(case$ident), levels = case$cluster_order))
+    }
+    # Calculate the mean, mean-sd, mean+sd
+    plotdata <- bardata %>%
+        group_by(!!sym(case$by), !!sym(case$ident)) %>%
+        summarise(.mean = mean(.frac), .sd = sd(.frac), .groups = "drop") %>%
+        rowwise() %>%
+        mutate(mean_sd1 = max(.mean - .sd, 0), mean_sd2 = .mean + .sd)
+
+    if (!is.null(case$colors) && length(case$colors) == 1 && case$colors == "biopipen") {
+        colors <- pal_biopipen(.8)(length(unique(plotdata[[case$by]])))
+    } else if (!is.null(case$colors) && length(case$colors) > 0) {
+        colors <- trimws(unlist(strsplit(case$colors, ",")))
+    }
+
+    # Plot the barplot
+    p = ggplot(plotdata, aes(x = !!sym(case$ident), y = .mean, fill = !!sym(case$by))) +
+        geom_bar(stat = "identity", position = "dodge", color = "#333333") +
+        geom_errorbar(
+            aes(ymin = mean_sd1, ymax = mean_sd2),
+            width = 0.2,
+            alpha = 0.5,
+            linewidth = 0.6,
+            position = position_dodge(0.9),
+            color = "#333333"
+        ) +
+        theme_prism(axis_text_angle = 45) +
+        ylab("Fraction of cells") +
+        scale_fill_manual(values = colors)
+
+    prefix = file.path(info$casedir, "barplot")
+    save_plot(p, prefix, case$bar_devpars)
+    neat_case <- list(by = case$by, ident = case$ident)
+    save_plotcode(
+        p,
+        setup = c(
+            'library(rlang)',
+            'library(ggplot2)',
+            'library(ggprism)',
+            '',
+            'load("data.RData")',
+            'case <- neat_case'
+        ),
+        prefix,
+        "plotdata", "neat_case", "colors")
+
+    # Do the tests in each cluster between groups on .frac
+    bys <- bardata %>% pull(!!sym(case$by)) %>% unique()
+    if (!is.null(case$test) && test != "none") {
+        if (length(bys) < 2) {
+            stop("  Cannot do tests with only one group.")
+        }
+
+        pairs <- combn(bys, 2, simplify = FALSE)
+        test_results <- NULL
+        for (pair in pairs) {
+            dat <- bardata %>%
+                filter(!!sym(case$by) %in% pair) %>%
+                select(!!sym(case$by), !!sym(case$ident), .frac) %>%
+                group_by(!!sym(case$ident)) %>%
+                summarise(
+                    comparison = paste0(pair, collapse = " - "),
+                    n = paste(as.list(table(!!sym(case$by)))[pair], collapse = "; "),
+                    mean = paste(
+                        (tibble(.frac, !!sym(case$by)) %>%
+                            group_by(!!sym(case$by)) %>%
+                            summarise(mean = mean(.frac)) %>%
+                            column_to_rownames(case$by) %>%
+                            t() %>%
+                            as.data.frame() %>%
+                            as.list())[pair] %>% unlist() %>% round(3),
+                        collapse = "; "
+                    ),
+                    !!sym(paste0(case$test, "_pval")) := ifelse(
+                        case$test == "wilcox",
+                        tryCatch(wilcox.test(.frac ~ !!sym(case$by))$p.value, error = function(e) NA),
+                        tryCatch(t.test(.frac ~ !!sym(case$by))$p.value, error = function(e) NA)
+                    )
+                )
+            test_results <- rbind(test_results, dat)
+        }
+        write.table(
+            test_results,
+            file.path(info$casedir, "tests.txt"),
+            sep = "\t",
+            quote = FALSE,
+            col.names = TRUE,
+            row.names = FALSE
+        )
+    }
 }
 
-# Expand the cases
-newcases = list()
-for (key in names(cases)) {
-    if (is.null(cases[[key]]$each)) {
-        newcases[[key]] = cases[[key]]
-    } else {
-        each_values = meta %>% pull(!!sym(cases[[key]]$each)) %>% unique() %>% na.omit()
-        for (evalue in each_values) {
-            ekey = if (key == DEFAULT_CASE) evalue else paste0(key, "_", evalue)
-            newcases[[ekey]] = cases[[key]]
-            newcases[[ekey]]$each_value = evalue
-            if (!is.null(cases[[key]]$section)) {
-                warn(
-                    sprintf("Case %s: `section` is ignored when `each` is specified.", key),
-                    immediate. = TRUE
+add_case_report = function(info, breakdown, test) {
+    report = list(
+        list(
+            name = "Radar Plot",
+            contents = list(
+                list(
+                    kind = "image",
+                    src = file.path(info$casedir, "plot.png"),
+                    download = list(
+                        file.path(info$casedir, "plot.pdf"),
+                        list(
+                            src = file.path(info$casedir, "plot.R"),
+                            tip = "Download the code used to reproduce the plot",
+                            icon = "Code"))
                 )
-            }
-            newcases[[ekey]]$section = key
+            )
+        ),
+        list(
+            name = "Count Table",
+            contents = list(
+                list(
+                    kind = "table",
+                    data = list(index_col = 0),
+                    src = file.path(info$casedir, "counts.tsv")
+                )
+            )
+        ),
+        list(
+            name = "Percentage Table",
+            contents = list(
+                list(
+                    kind = "table",
+                    data = list(index_col = 0),
+                    src = file.path(info$casedir, "percentages.tsv")
+                )
+            )
+        )
+    )
+    if (!is.null(breakdown)) {
+        report = c(
+            report,
+            list(list(
+                name = "Barplot",
+                contents = list(
+                    list(
+                        kind = "image",
+                        src = file.path(info$casedir, "barplot.png"),
+                        download = list(
+                            file.path(info$casedir, "barplot.pdf"),
+                            list(
+                                src = file.path(info$casedir, "barplot.code.zip"),
+                                tip = "Download the code used to reproduce the plot",
+                                icon = "Code"
+                            )
+                        )
+                    )
+                )
+            ))
+        )
+        if (!is.null(test) && test != "none") {
+            report = c(
+                report,
+                list(list(
+                    name = "Tests",
+                    contents = list(
+                        list(
+                            kind = "table",
+                            src = file.path(info$casedir, "tests.txt")
+                        )
+                    )
+                ))
+            )
         }
     }
+    report$h1 = info$h1
+    report$h2 = info$h2
+    report$ui = "tabs"
+    do_call(add_report, report)
 }
 
-casenames = names(newcases)
-sapply(casenames, run_one_case)
-
-print("- Saving sections if any ...")
-if (length(sections) > 0) {
-    # Write as TOML
-    #  section1 = ["case1", "case2"]
-    #  section2 = ["case3", "case4"]
-    #  ...
-    outstr = c()
-    for (sec in names(sections)) {
-        sec_str = paste0(sec, " = ")
-        sec_str = paste0(sec_str, "['", paste(sections[[sec]], collapse = "', '"), "']")
-        outstr = c(outstr, sec_str)
+run_one_case <- function(casename) {
+    info <- casename_info(casename, cases, outdir, create = TRUE)
+    case <- cases[[casename]]
+    log_info("- Running for case: {casename}")
+
+    if (!is.null(case$subset)) {
+        m <- meta %>% dplyr::filter(!!rlang::parse_expr(case$subset))
+    } else {
+        m <- meta
+    }
+    # Get the counts
+    if (!is.null(case$each)) {
+        counts <- m %>% dplyr::filter(!!sym(case$each) == case$each_value)
+    } else {
+        counts <- m
+    }
+    counts <- counts %>% drop_na(!!sym(case$by)) %>% drop_na(!!sym(case$ident))
+    do_radarplot(info, case, counts)
+
+    if (!is.null(case$breakdown)) {
+        do_barplot_and_tests(info, case, counts)
     }
-    section_file = file.path(outdir, "sections.toml")
-    writeLines(outstr, section_file)
-}
+
+    add_case_report(info, case$breakdown, case$test)
+}
+
+sapply(sort(names(cases)), run_one_case)
+
+save_report(joboutdir)