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

biopipen/scripts/tcr/CloneResidency.R

@@ -1,4 +1,4 @@
-source("{{biopipen_dir}}/utils/misc.R")
+{{ biopipen_dir | joinpaths: "utils", "misc.R" | source_r }}
 
 library(rlang)
 library(dplyr)
@@ -9,14 +9,15 @@ library(ggnewscale)
 library(ggplot2)
 library(ggprism)
 library(ggVennDiagram)
-library(UpSetR)
+library(ComplexUpset)
 
 theme_set(theme_prism())
 
 
-immfile <- {{ in.immdata | quote }}
+immfile <- {{ in.immdata | r }}
 metafile <- {{ in.metafile | r }}
-outdir <- {{ out.outdir | quote }}
+outdir <- {{ out.outdir | r }}
+joboutdir <- {{ job.outdir | r }}
 
 subject_key <- {{ envs.subject | r }}
 group_key <- {{ envs.group | r }}
@@ -25,11 +26,13 @@ section <- {{ envs.section | r }}
 mutaters <- {{ envs.mutaters | r }}
 subset <- {{ envs.subset | r }}
 prefix <- {{ envs.prefix | r }}
+upset_ymax <- {{ envs.upset_ymax | r }}
+upset_trans <- {{ envs.upset_trans | r }}
 cases <- {{ envs.cases | r }}
 
 # Fill up cases using `envs.xxx` if not provided and compose a DEFAULT case
 # if no cases are provided
-print("- Preparing cases...")
+log_info("Preparing cases...")
 if (is.null(cases) || length(cases) == 0) {
     cases <- list(
         DEFAULT = list(
@@ -37,34 +40,28 @@ if (is.null(cases) || length(cases) == 0) {
             group = group_key,
             order = sample_order,
             subset = subset,
-            section = section
+            section = section,
+            upset_ymax = upset_ymax,
+            upset_trans = upset_trans
         )
     )
 } else {
     for (key in names(cases)) {
-        if (is.null(cases[[key]]$subject)) {
-            cases[[key]]$subject <- subject_key
-        }
-        if (is.null(cases[[key]]$group)) {
-            cases[[key]]$group <- group_key
-        }
-        if (is.null(cases[[key]]$order)) {
-            cases[[key]]$order <- sample_order
-        }
-        if (is.null(cases[[key]]$section)) {
-            cases[[key]]$section <- section
-        }
-        if (is.null(cases[[key]]$subset)) {
-            cases[[key]]$subset <- subset
-        }
+        cases[[key]]$subject <- cases[[key]]$subject %||% subject_key
+        cases[[key]]$group <- cases[[key]]$group %||% group_key
+        cases[[key]]$order <- cases[[key]]$order %||% sample_order
+        cases[[key]]$section <- cases[[key]]$section %||% section
+        cases[[key]]$subset <- cases[[key]]$subset %||% subset
+        cases[[key]]$upset_ymax <- cases[[key]]$upset_ymax %||% upset_ymax
+        cases[[key]]$upset_trans <- cases[[key]]$upset_trans %||% upset_trans
     }
 }
 
-print("- Preparing data ...")
-print("  Loading immdata ...")
+log_info("Preparing data ...")
+log_info("- Loading immdata ...")
 immdata <- readRDS(immfile)
 
-print("  Expanding immdata$data to cell-level ...")
+log_info("- Expanding immdata$data to cell-level ...")
 cldata <- do_call(rbind, lapply(names(immdata$data), function(name) {
     dat <- immdata$data[[name]] %>% separate_rows(Barcode, sep = ";") # Split barcodes
     dat$Sample <- name
@@ -76,7 +73,7 @@ cldata <- do_call(rbind, lapply(names(immdata$data), function(name) {
 }))
 
 if (!is.null(metafile)) {
-    print("  Loading metafile ...")
+    log_info("- Loading metafile ...")
     # Check if extension is rds/RDS, if so, it should be a Seurat object
     if (endsWith(metafile, ".rds") || endsWith(metafile, ".RDS")) {
         meta <- readRDS(metafile)@meta.data
@@ -86,14 +83,14 @@ if (!is.null(metafile)) {
         )
     }
 
-    print("  Merging metafile to cldata ...")
+    log_info("- Merging metafile to cldata ...")
     cldata <- cbind(
         cldata,
         meta[cldata$Barcode, setdiff(colnames(meta), colnames(cldata)), drop = FALSE]
     )
 }
 
-print("- Applying mutaters ...")
+log_info("Applying mutaters ...")
 if (!is.null(mutaters) && length(mutaters) > 0) {
     cldata <- cldata %>% mutate(!!!lapply(mutaters, parse_expr))
 }
@@ -115,13 +112,13 @@ get_groups <- function(order) {
 }
 
 perpare_case <- function(casename, case) {
-    print(paste("- Preparing case:", casename, "..."))
+    log_info("- Processing case: {casename} ...")
     # Check if required keys are provided
     if (is.null(case$subject) || length(case$subject) == 0) {
-        stop(paste("`subject` is required for case:", casename))
+        stop(paste("  `subject` is required for case:", casename))
     }
     if (is.null(case$group) || length(case$group) == 0) {
-        stop(paste("`group` is required for case:", casename))
+        stop(paste("  `group` is required for case:", casename))
     }
     if (!is.null(case$order) && length(case$order) > 0) {
         has_comma <- grepl(",", case$order)
@@ -133,14 +130,8 @@ perpare_case <- function(casename, case) {
             ))
         } else if (!any(has_comma)) {
             if (length(case$order) > 2) {
-                warning(
-                    paste0(
-                        "- Order of groups in case:", casename,
-                        " is not recommended, please use comma to separate groups. \n",
-                        "Instead of `['A', 'B', 'C']`, use `['A,B', 'A,C', 'B,C']`."
-                    ),
-                    immediate. = TRUE
-                )
+                log_warn("  Order of groups is not recommended, please use comma to separate groups.")
+                log_warn("  Instead of `['A', 'B', 'C']`, use `['A,B', 'A,C', 'B,C']`.")
                 case$order <- sapply(
                     combn(case$order, 2, simplify = FALSE),
                     function(x) paste(x, collapse = ",")
@@ -151,8 +142,8 @@ perpare_case <- function(casename, case) {
         } else {
             stop(
                 paste0(
-                    "- Order of groups in case:", casename,
-                    " is not consistent, please use comma to separate groups. \n",
+                    "  Order of groups in case:", casename,
+                    " is not consistent, please use comma to separate groups. ",
                     "Instead of `['A', 'B', 'C']`, use `['A,B', 'A,C', 'B,C']`, ",
                     "however, this is inconsistent: `['A,B', 'C']`"
                 )
@@ -162,19 +153,19 @@ perpare_case <- function(casename, case) {
 
     # Create case-specific directories
     # Scatter plots
-    scatter_dir <- file.path(outdir, casename, "scatter")
+    scatter_dir <- file.path(outdir, slugify(casename), "scatter")
     dir.create(scatter_dir, recursive = TRUE, showWarnings = FALSE)
 
     # Venn diagrams
-    venn_dir <- file.path(outdir, casename, "venn")
+    venn_dir <- file.path(outdir, slugify(casename), "venn")
     dir.create(venn_dir, recursive = TRUE, showWarnings = FALSE)
 
     # Upset plots
-    upset_dir <- file.path(outdir, casename, "upset")
+    upset_dir <- file.path(outdir, slugify(casename), "upset")
     dir.create(upset_dir, recursive = TRUE, showWarnings = FALSE)
 
     # Counts
-    counts_dir <- file.path(outdir, casename, "counts")
+    counts_dir <- file.path(outdir, slugify(casename), "counts")
     dir.create(counts_dir, recursive = TRUE, showWarnings = FALSE)
 
     case
@@ -255,14 +246,16 @@ plot_scatter <- function(counts, subject, suf1, suf2) {
     }
     ggplot(plotdata) +
         geom_point(
-            aes_string(
-                x = bQuote(suf1), y = bQuote(suf2), color = "Type", size = "Size", fill = "Type"
+            aes(
+                x = !!sym(suf1),
+                y = !!sym(suf2),
+                color = Type,
+                size = Size,
+                fill = Type
             ),
             alpha = .6,
             shape = 21
         ) +
-        # geom_point(aes_string(x=x, y=y, color='color'), shape=1) +
-        # scale_color_manual(values=color) +
         scale_x_continuous(
             trans = "log2",
             limits = c(minx, maxx),
@@ -277,7 +270,6 @@ plot_scatter <- function(counts, subject, suf1, suf2) {
         ) +
         theme_prism(base_size = 16) +
         scale_size(guide = "none") +
-        # theme(legend.position = "none") +
         labs(
             title = bquote(.(subject) ~ (italic(n) == .(n_formatted))),
             subtitle = subtitle
@@ -302,80 +294,115 @@ plot_venndg <- function(counts, groups, singletons) {
     venn <- Venn(venn_data)
     vdata <- process_data(venn)
     vregion <- venn_region(vdata)
-    sregion <- head(vregion, length(groups))
-    sregion$count = singletons[sregion$name, "count"]
-    sregion <- sregion %>% mutate(name = paste0(name, " singletons"))
+    vregion$singleton_count = singletons[vregion$name, "count"]
     vregion <- vregion %>% mutate(
         count_perc = round(count / sum(count) * 100, 1),
-        count_str = paste0(count, " (", count_perc, "%)")
+        count_str = paste0(count, " (", count_perc, "%)"),
+        count_str = if_else(is.na(singleton_count), count_str, paste0(count_str, "\nsingletons = ", singleton_count))
     )
 
-    # Align the catagory labels
-    cat_nudge_y <- 0
-    if (length(groups) == 3) { cat_nudge_y <- c(-400, 0, -400) }
-    # Shift Count labels
-    count_nudge_y <- -10
-    if (length(groups) == 3) { count_nudge_y <- c(20, -20, 20, rep(0, nrow(vregion) - 3))  }
-    # Shift the singletons stat labels
-    label_nudge_y <- 60
-    if (length(groups) == 3) { label_nudge_y <- c(60, -60, -60) }
-
     venn_p <- ggplot() +
         # 1. region count layer
         geom_sf(aes(fill = count), data = venn_region(vdata)) +
         # 2. set edge layer
         # geom_sf(aes(color = factor(id)), data = venn_setedge(data), show.legend = FALSE) +
         # 3. set label layer
-        geom_sf_text(aes(label = name), data = venn_setlabel(vdata), nudge_y = cat_nudge_y) +
+        geom_sf_text(aes(label = name), data = venn_setlabel(vdata)) +
         # 4. region label layer
         geom_sf_label(
             aes(label = count_str),
             alpha = .8,
             label.padding = unit(.2, "lines"),
-            data = vregion,
-            nudge_y = count_nudge_y
+            data = vregion
         ) +
         # 5. singletons label layer
         scale_fill_distiller(palette = "Oranges", direction = 1) +
-        new_scale_fill() +
-        geom_sf_label(
-            aes(label = count, fill = name),
-            alpha = .6,
-            data = sregion,
-            nudge_y = label_nudge_y,
-            label.padding = unit(1, "lines"),
-            label.r = unit(1.2, "lines"),
-            label.size = 0.05,
-            show.legend = TRUE
-        ) +
         theme_void() +
-        theme(plot.margin = margin(1,1,1,1, "cm")) +
-        scale_fill_brewer(palette = "Reds", name = "Singletons")
+        theme(plot.margin = margin(1,1,1,1, "cm"))
 
     venn_p
 }
 
-plot_upset <- function(counts, singletons) {
-    query_singleton <- function(row) { row["Singletons"] == "true" }
+plot_upset <- function(counts, singletons, upset_ymax, upset_trans) {
 
     cnts <- column_to_rownames(counts, "CDR3.aa") %>%
         mutate(across(everything(), ~ as.integer(as.logical(.x))))
     sgltns <- unlist(singletons$CDR3.aa)
-    cnts$Singletons <- "none"
-    cnts[sgltns, "Singletons"] <- "true"
-    sets <- setdiff(colnames(cnts), "Singletons")
+    cnts$..type <- "Multiplets"
+    cnts[sgltns, "..type"] <- "Singletons"
+    sets <- setdiff(colnames(cnts), "..type")
+
+    p <- ggplot(mapping = aes(x = intersection, fill = ..type)) +
+        theme(
+            legend.position = "top",
+            legend.title = element_blank(),
+            panel.grid = element_blank(),
+            axis.line.y = element_line(color = "#3b3b3b"),
+            axis.ticks.y = element_line(color = "#3b3b3b"),
+        ) +
+        scale_fill_manual(values = c("#3b3b3b", "orange")) +
+        ylab("Intersection size")
+
+    if (is.null(upset_trans)) {
+        p <- p + geom_bar(stat = "count", position = "stack") +
+            geom_text(
+                aes(label = ..count.., vjust = ifelse(..type == "Multiplets", -0.25, +1.25)),
+                stat = "count", position = "stack", size = 2.8)
+        if (!is.null(upset_ymax)) {
+            p <- p + ylim(0, upset_ymax)
+        }
+    } else {
+        p <- p + geom_bar(stat = "count", position = "dodge2") +
+            geom_text(
+                aes(label = ..count..),
+                stat = "count", position = position_dodge(width = 0.9), vjust = -0.25, size = 2.5)
+
+        # limit the y and do log10 transformation
+        if (!is.null(upset_ymax)) {
+            p <- p + scale_y_continuous(trans = "log10", limits = c(1, upset_ymax))
+        } else {
+            p <- p + scale_y_continuous(trans = "log10")
+        }
+    }
 
-    upset(cnts, sets = sets, query.legend = "top", sets.x.label = "# clones", queries = list(
-        list(
-            query = query_singleton,
-            color = "orange",
-            active = TRUE,
-            query.name = "Singletons"
+    upset(
+        cnts, rev(sets),
+        sort_sets = FALSE,
+        # Remove the base annotations
+        base_annotations = list(),
+        annotations = list('IntersectSize' = p),
+        themes = upset_modify_themes(
+            list(
+                intersections_matrix = theme(
+                    axis.line = element_line(color = "#3b3b3b"),
+                    axis.ticks.y = element_line(color = "#3b3b3b"),
+                )
+            )
         )
-    ))
+    )
+}
+
+headings <- function(section, casename, subject) {
+    list(h1 = ifelse(
+            is.null(section),
+            ifelse(casename == "DEFAULT", subject, casename),
+            section
+        ),
+        h2 = ifelse(
+            is.null(section),
+            ifelse(casename == "DEFAULT", "#", subject),
+            ifelse(casename == "DEFAULT", subject, casename)
+        ),
+        h3 = ifelse(
+            is.null(section),
+            "#",
+            ifelse(casename == "DEFAULT", "#", subject)
+        )
+    )
 }
 
 handle_subject <- function(i, subjects, casename, case) {
+    casedir = file.path(outdir, slugify(casename))
     # Generate a residency table
     # |    CDR3.aa    | Tumor | Normal |
     # | SEABESRWEFAEF | 0     | 10     |
@@ -384,10 +411,10 @@ handle_subject <- function(i, subjects, casename, case) {
     subject_row <- subjects[i, , drop = FALSE]
     subject <- subject_row %>%
         select(all_of(case$subject)) %>%
-        as.character() %>%
+        mutate(across(everything(), as.character)) %>%
         paste(collapse = "-")
 
-    print(paste("- Handling", i, case$subject, "..."))
+    log_info("  Handling {i}/{nrow(subjects)}: {subject} ...")
 
     if (!is.null(case$subset)) {
         counts <- cldata %>% filter(!!parse_expr(case$subset))
@@ -412,10 +439,7 @@ handle_subject <- function(i, subjects, casename, case) {
         case$order <- sapply(combn(groups, 2, simplify = FALSE), function(x) paste(x, collapse = ","))
     }
     if (length(unique(counts[[case$group]])) < 2) {
-        warning(
-            paste0("-", casename, ", Subject doesn't have enough groups:", subject),
-            immediate. = TRUE
-        )
+        log_warn("  - Subject doesn't have enough groups: {subject}")
         return()
     }
     singletons = counts %>%
@@ -435,70 +459,107 @@ handle_subject <- function(i, subjects, casename, case) {
         select(CDR3.aa, !!!syms(groups))
     counts[is.na(counts)] <- 0
 
-    # Save samples to group_by so they can be aligned accordingly in the report
-    if (!is.null(section)) {
-        group_dir <- file.path(outdir, casename, "section")
-        dir.create(group_dir, showWarnings = FALSE)
-
-        sgroups <- subject_row %>%
-            left_join(cldata) %>%
-            pull(section) %>%
-            unique() %>%
-            paste(collapse = "-")
-        group_file <- file.path(group_dir, paste0(sgroups, ".txt"))
-        cat(subject, file = group_file, sep = "\n", append = TRUE)
-    }
-
     # Save counts
-    counts_dir <- file.path(outdir, casename, "counts")
+    counts_dir <- file.path(casedir, "counts")
+    countfile <- file.path(counts_dir, paste0(slugify(subject), ".txt"))
     write.table(
         counts,
-        file = file.path(counts_dir, paste0(subject, ".txt")),
+        file = countfile,
         sep = "\t",
         row.names = TRUE,
         col.names = TRUE,
         quote = FALSE
     )
 
+    h <- headings(case$section, casename, "Clone Size Tables")
+    add_report(
+        list(kind = "table", src = countfile, ds_name = subject),
+        h1 = h$h1,
+        h2 = h$h2,
+        h3 = h$h3,
+        ui = "dropdown_switcher"
+    )
+
     # scatter plot
     # Make plots B ~ A, C ~ B, and C ~ A for order A, B, C
     # combns <- combn(groups, 2, simplify = FALSE)
-    scatter_dir <- file.path(outdir, casename, "scatter")
+    h <- headings(case$section, casename, "Residency Plots")
+    scatter_dir <- file.path(casedir, "scatter")
     for (j in seq_along(case$order)) {
         pair <- strsplit(case$order[j], ",")[[1]]
         if (length(setdiff(pair, groups)) > 0) {
-            warning(
-                paste0(
-                    "- One of the comparisons doesn't exist in case (", casename,
-                    ") for subject (", subject, "): ",
-                    case$order[j]
-                ),
-                immediate. = TRUE
-            )
+            log_warn("  - Comparison {case$order[j]} doesn't exist.")
             next
         }
         scatter_p <- plot_scatter(counts, subject, pair[1], pair[2])
         scatter_png <- file.path(
             scatter_dir,
-            paste0("scatter_", subject, "_", pair[1], "_", pair[2], ".png")
+            paste0("scatter_", slugify(subject), "_", slugify(pair[1]), "_", slugify(pair[2]), ".png")
         )
         png(scatter_png, res = 100, height = 800, width = 1000)
         print(scatter_p)
         dev.off()
+
+        scatter_pdf <- gsub(".png$", ".pdf", scatter_png)
+        pdf(scatter_pdf, width = 10, height = 8)
+        print(scatter_p)
+        dev.off()
+
+        add_report(
+            list(
+                name = paste0(subject, " (", pair[1], " - ", pair[2], ")"),
+                src = scatter_png,
+                download = scatter_pdf
+            ),
+            h1 = h$h1,
+            h2 = h$h2,
+            h3 = h$h3,
+            ui = "table_of_images:3"
+        )
     }
 
     # upset/venn
-    venn_dir <- file.path(outdir, casename, "venn")
-    venn_png <- file.path(venn_dir, paste0("venn_", subject, ".png"))
+    venn_dir <- file.path(casedir, "venn")
+    venn_png <- file.path(venn_dir, paste0("venn_", slugify(subject), ".png"))
+    venn_pdf <- gsub(".png$", ".pdf", venn_png)
+    p <- plot_venndg(counts, groups, singletons)
     png(venn_png, res = 100, height = 600, width = 800)
-    print(plot_venndg(counts, groups, singletons))
+    print(p)
     dev.off()
 
-    upset_dir <- file.path(outdir, casename, "upset")
-    upset_png <- file.path(upset_dir, paste0("upset_", subject, ".png"))
+    pdf(venn_pdf, width = 8, height = 6)
+    print(p)
+    dev.off()
+
+    h <- headings(case$section, casename, "Overlapping Clones (Venn Diagram)")
+    add_report(
+        list(src = venn_png, name = subject, download = venn_pdf),
+        h1 = h$h1,
+        h2 = h$h2,
+        h3 = h$h3,
+        ui = "table_of_images:3"
+    )
+
+    upset_dir <- file.path(casedir, "upset")
+    upset_png <- file.path(upset_dir, paste0("upset_", slugify(subject), ".png"))
+    upset_pdf <- gsub(".png$", ".pdf", upset_png)
+    p <- plot_upset(counts, singletons, case$upset_ymax, case$upset_trans)
     png(upset_png, res = 100, height = 600, width = 800)
-    print(plot_upset(counts, singletons))
+    print(p)
     dev.off()
+
+    pdf(upset_pdf, width = 8, height = 6)
+    print(p)
+    dev.off()
+
+    h <- headings(case$section, casename, "Overlapping Clones (UpSet Plots)")
+    add_report(
+        list(src = upset_png, name = subject, download = upset_pdf),
+        h1 = h$h1,
+        h2 = h$h2,
+        h3 = h$h3,
+        ui = "table_of_images:3"
+    )
 }
 
 handle_case <- function(casename, case) {
@@ -513,9 +574,72 @@ handle_case <- function(casename, case) {
             distinct(!!!syms(case$subject)) %>%
             drop_na()
     }
+
+    h <- headings(case$section, casename, "Clone Size Tables")
+    add_report(
+        list(ds_name = "Select a subject ..."),
+        h1 = h$h1,
+        h2 = h$h2,
+        h3 = h$h3,
+        ui = "dropdown_switcher"
+    )
+
+    h <- headings(case$section, casename, "Residency Plots")
+    add_report(
+        list(
+            kind = "descr",
+            content = paste0(
+                "The residency plots showing the clones of paired samples (x-axis and y-axis). ",
+                "The size of the dot represents the relative abundance of the clone. ",
+                "The color of the dot represents the type of the clone: "
+            )
+        ),
+        list(
+            kind = "list",
+            items = c(
+                "Collapsed (clones that are less abundant in the y-axis sample)",
+                "Dual (clones that are equally abundant in both samples)",
+                "Expanded (clones that are more abundant in the y-axis sample)",
+                "(x-axis sample) Multiplet (clones that are only present in the x-axis sample, with multiple cells)",
+                "(x-axis sample) Singleton (clones that are only present in the x-axis sample, with a single cell)",
+                "(y-axis sample) Multiplet (clones that are only present in the y-axis sample, with multiple cells)",
+                "(y-axis sample) Singleton (clones that are only present in the y-axis sample, with a single cell)"
+            )
+        ),
+        h1 = h$h1,
+        h2 = h$h2,
+        h3 = h$h3,
+        ui = "flat"
+    )
+
+    h <- headings(case$section, casename, "Overlapping Clones (Venn Diagram)")
+    add_report(
+        list(
+            kind = "descr",
+            content = "For samples in each subject, showing the overlapping clones between samples in Venn diagrams."
+        ),
+        h1 = h$h1,
+        h2 = h$h2,
+        h3 = h$h3,
+        ui = "flat"
+    )
+
+    h <- headings(case$section, casename, "Overlapping Clones (UpSet Plots)")
+    add_report(
+        list(
+            kind = "descr",
+            content = "For samples in each subject, showing the overlapping clones between samples in UpSet plots."
+        ),
+        h1 = h$h1,
+        h2 = h$h2,
+        h3 = h$h3,
+        ui = "flat"
+    )
     sapply(seq_len(nrow(subjects)), handle_subject, subjects, casename, case)
 }
 
-for (casename in names(cases)) {
+for (casename in sort(names(cases))) {
     handle_case(casename, cases[[casename]])
-}
+}
+
+save_report(joboutdir)

biopipen/scripts/tcr/CloneSizeQQPlot.R

@@ -1,13 +1,13 @@
-source("{{biopipen_dir}}/utils/misc.R")
-source("{{biopipen_dir}}/utils/plot.R")
+{{ biopipen_dir | joinpaths: "utils", "misc.R" | source_r }}
+{{ biopipen_dir | joinpaths: "utils", "plot.R" | source_r }}
 
 library(dplyr)
 library(tidyr)
 library(ggprism)
 
 
-immfile <- {{ in.immdata | quote }}
-outdir <- {{ out.outdir | quote }}
+immfile <- {{ in.immdata | r }}
+outdir <- {{ out.outdir | r }}
 
 subject_key <- {{ envs.subject | r }}
 group_key <- {{ envs.group | r }}