biopipen 0.21.2__py3-none-any.whl → 0.22.1__py3-none-any.whl

biopipen/scripts/scrna/RadarPlots.R

@@ -1,3 +1,5 @@
+source("{{biopipen_dir}}/utils/misc.R")
+
 library(Seurat)
 library(rlang)
 library(dplyr)
@@ -5,10 +7,12 @@ library(tidyr)
 library(tibble)
 library(ggplot2)
 library(ggradar)
+library(slugify)
 
 # input/output
 srtfile = {{in.srtobj | r}}
 outdir = {{out.outdir | r}}
+joboutdir = {{job.outdir | r}}
 
 # envs
 mutaters = {{envs.mutaters | r}}
@@ -24,9 +28,96 @@ devpars = {{envs.devpars | r}}
 cases = {{envs.cases | r}}
 
 DEFAULT_CASE = "DEFAULT"
+sections = c()
+
+log_info("Reading srtobj ...")
+srtobj = readRDS(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)
+}
+
+# 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
+    )
+} 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
+        }
+    }
+}
 
-# Used for saving sections
-sections = list()
+# Expand the cases
+newcases = list()
+for (key in names(cases)) {
+    if (is.null(cases[[key]]$each)) {
+        sections <- c(sections, cases[[key]]$section)
+        newcases[[paste0(cases[[key]]$section, ":", key)]] = cases[[key]]
+    } else {
+        each_values = meta %>% pull(!!sym(cases[[key]]$each)) %>% unique() %>% na.omit()
+        sections <- c(sections, key)
+        for (evalue in each_values) {
+            ekey = paste0(key, ":", evalue)
+            newcases[[ekey]] = cases[[key]]
+            newcases[[ekey]]$each_value = evalue
+            if (!is.null(cases[[key]]$section)) {
+                log_warn(
+                    sprintf("Case %s: `section` is ignored when `each` is specified.", key)
+                )
+            }
+        }
+    }
+}
+
+single_section <- length(sections) == 1 && sections[[1]] == "DEFAULT"
 
 auto_breaks = function(maxval) {
     if (maxval <= 0.1) {  # 10%
@@ -52,14 +143,28 @@ auto_breaks = function(maxval) {
     }
 }
 
-run_one_case = function(casename) {
-    case = newcases[[casename]]
-    print(paste("- Running for case:", casename))
+casename_info <- function(casename, create = FALSE) {
+    sec_case_names <- strsplit(casename, ":")[[1]]
+    cname <- paste(sec_case_names[-1], collapse = ":")
 
-    # Save the section
-    if (is.character(case$section) && nchar(case$section) > 0) {
-        sections[[case$section]] <<- c(sections[[case$section]], casename)
+    out <- list(
+        casename = casename,
+        section = sec_case_names[1],
+        case = cname,
+        section_slug = slugify(sec_case_names[1], tolower = FALSE),
+        case_slug = slugify(cname, tolower = FALSE)
+    )
+    out$casedir <- file.path(outdir, out$section_slug, out$case_slug)
+    if (create) {
+        dir.create(out$casedir, showWarnings = FALSE, recursive = TRUE)
     }
+    out
+}
+
+run_one_case = function(casename) {
+    info = casename_info(casename, create = TRUE)
+    case = newcases[[casename]]
+    log_info("Running for case: {casename}")
 
     # Get the counts
     counts = if (!is.null(case$each)) meta %>% filter(!!sym(case$each) == case$each_value) else meta
@@ -97,9 +202,10 @@ run_one_case = function(casename) {
     }
 
     # Save the counts
+    counts_file = file.path(info$casedir, "counts.tsv")
     write.table(
         counts,
-        file.path(outdir, paste0(casename, ".counts.tsv")),
+        counts_file,
         sep = "\t",
         quote = FALSE,
         col.names = TRUE,
@@ -115,9 +221,10 @@ run_one_case = function(casename) {
     }
 
     # Save the percentages
+    perc_file = file.path(info$casedir, "percentages.tsv")
     write.table(
         counts,
-        file.path(outdir, paste0(casename, ".percentages.tsv")),
+        perc_file,
         sep = "\t",
         quote = FALSE,
         col.names = TRUE,
@@ -132,126 +239,72 @@ run_one_case = function(casename) {
     }
 
     # Plot
+    plotfile = file.path(info$casedir, "plot.png")
     p = ggradar(
         counts %>% as.data.frame() %>% rownames_to_column("group"),
         values.radar = paste0(breaks, "%"),
         grid.min = breaks[1] / 100,
         grid.mid = breaks[2] / 100,
         grid.max = breaks[3] / 100,
-        plot.title = casename
+        group.colours = pal_biopipen()(nrow(counts))
     )
     png(
-        file.path(outdir, paste0(casename, ".png")),
+        plotfile,
         width = case$devpars$width,
         height = case$devpars$height,
         res = case$devpars$res
     )
     print(p)
     dev.off()
-}
 
-# 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
-    )
-} 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
-        }
-    }
+    add_case_report(info)
 }
 
-print("- Reading srtobj ...")
-srtobj = readRDS(srtfile)
-meta = srtobj@meta.data
-
-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)
-}
-
-# 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) {
+    add_report(
+        list(
+            name = "Radar Plot",
+            contents = list(
+                list(
+                    kind = "image",
+                    src = file.path(info$casedir, "plot.png")
                 )
-            }
-            newcases[[ekey]]$section = key
-        }
-    }
+            )
+        ),
+        list(
+            name = "Count Table",
+            contents = list(
+                list(
+                    kind = "table",
+                    src = file.path(info$casedir, "counts.tsv")
+                )
+            )
+        ),
+        list(
+            name = "Percentage Table",
+            contents = list(
+                list(
+                    kind = "table",
+                    src = file.path(info$casedir, "percentages.tsv")
+                )
+            )
+        ),
+        h1 = ifelse(
+            info$section == "DEFAULT",
+            info$case,
+            ifelse(single_section, paste0(info$section, " - ", info$case), info$section)
+        ),
+        h2 = ifelse(
+            info$section == "DEFAULT",
+            "#",
+            ifelse(single_section, "#", info$case)
+        ),
+        ui = "tabs"
+    )
 }
 
+
 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)
-    }
-    section_file = file.path(outdir, "sections.toml")
-    writeLines(outstr, section_file)
-}
+save_report(joboutdir)

biopipen/scripts/scrna/ScFGSEA.R

@@ -4,9 +4,11 @@ source("{{biopipen_dir}}/utils/mutate_helpers.R")
 library(rlang)
 library(Seurat)
 library(tidyseurat)
+library(slugify)
 
 srtfile <- {{in.srtobj | r}}  # nolint
 outdir <- {{out.outdir | r}}  # nolint
+joboutdir <- {{job.outdir | r}}  # nolint
 mutaters <- {{envs.mutaters | r}}  # nolint
 group.by <- {{envs["group-by"] | r}}  # nolint
 ident.1 <- {{envs["ident-1"] | r}}  # nolint
@@ -23,11 +25,15 @@ ncores <- {{envs.ncores | r}}  # nolint
 rest <- {{envs.rest | r: todot="-"}}  # nolint
 cases <- {{envs.cases | r: todot="-"}}  # nolint
 
+log_info("Reading srtobj...")
+
 srtobj <- readRDS(srtfile)
 if (!is.null(mutaters) && length(mutaters) > 0) {
     srtobj@meta.data <- srtobj@meta.data %>% mutate(!!!lapply(mutaters, parse_expr))
 }
 
+single_section <- TRUE
+
 expand_cases <- function() {
     # fill up cases with missing parameters
     if (is.null(cases) || length(cases) == 0) {
@@ -73,13 +79,16 @@ expand_cases <- function() {
     }
 
     outcases <- list()
+    sections <- c()
     # expand each
     for (name in names(filled_cases)) {
         case <- filled_cases[[name]]
         if (is.null(case$each) || nchar(case$each) == 0) {
+            sections <- c(sections, case$section)
             outcases[[paste0(case$section, ":", name)]] <- case
         } else {
             eachs <- srtobj@meta.data %>% pull(case$each) %>% na.omit() %>% unique() %>% as.vector()
+            sections <- c(sections, case$each)
             for (each in eachs) {
                 by <- make.names(paste0(".", name, "_", case$each,"_", each))
                 srtobj@meta.data <<- srtobj@meta.data %>%
@@ -98,19 +107,34 @@ expand_cases <- function() {
             }
         }
     }
+    single_section <- length(unique(sections)) == 1
     outcases
 }
 
+casename_info <- function(casename, create = FALSE) {
+    sec_case_names <- strsplit(casename, ":")[[1]]
+    cname <- paste(sec_case_names[-1], collapse = ":")
+
+    out <- list(
+        casename = casename,
+        section = sec_case_names[1],
+        case = cname,
+        section_slug = slugify(sec_case_names[1], tolower = FALSE),
+        case_slug = slugify(cname, tolower = FALSE)
+    )
+    out$casedir <- file.path(outdir, out$section_slug, out$case_slug)
+    if (create) {
+        dir.create(out$casedir, showWarnings = FALSE, recursive = TRUE)
+    }
+    out
+}
+
 do_case <- function(name, case) {
-    print(paste("- Processing case:", name, "..."))
-    section_case <- unlist(strsplit(name, ":"))
-    section <- section_case[1]
-    casename <- paste(section_case[-1], collapse = ":")
-    case_dir <- file.path(outdir, section, casename)
-    dir.create(case_dir, showWarnings = FALSE, recursive = TRUE)
+    log_info("- Doing case: {name} ...")
+    info <- casename_info(name, create = TRUE)
 
     # prepare expression matrix
-    print("  Preparing expression matrix...")
+    log_info("  Preparing expression matrix...")
     sobj <- srtobj %>% filter(!is.na(!!sym(case$group.by)))
     if (!is.null(case$ident.2)) {
         sobj <- sobj %>% filter(!!sym(case$group.by) %in% c(case$ident.1, case$ident.2))
@@ -124,11 +148,11 @@ do_case <- function(name, case) {
     exprs <- GetAssayData(sobj, slot = "data", assay = "RNA")
 
     # get preranks
-    print("  Getting preranks...")
+    log_info("  Getting preranks...")
     ranks <- prerank(exprs, case$ident.1, case$ident.2, allclasses, case$method)
     write.table(
         ranks,
-        file.path(case_dir, "fgsea.rank"),
+        file.path(info$casedir, "fgsea.rank"),
         row.names = FALSE,
         col.names = TRUE,
         sep = "\t",
@@ -136,13 +160,29 @@ do_case <- function(name, case) {
     )
 
     # run fgsea
-    print("  Running fgsea...")
+    log_info("  Running fgsea...")
     case$rest$minSize <- case$minsize
     case$rest$maxSize <- case$maxsize
     case$rest$eps <- case$eps
     case$rest$nproc <- case$ncores
-    runFGSEA(ranks, gmtfile, case$top, case_dir, case$rest)
+    runFGSEA(ranks, gmtfile, case$top, info$casedir, case$rest)
+
+    add_report(
+        list(kind = "fgsea", dir = info$casedir),
+        h1 = ifelse(
+            info$section == "DEFAULT",
+            info$case,
+            ifelse(single_section, paste0(info$section, " - ", info$case), info$section)
+        ),
+        h2 = ifelse(
+            info$section == "DEFAULT",
+            "#",
+            ifelse(single_section, "#", info$case)
+        )
+    )
 }
 
 cases <- expand_cases()
 sapply(sort(names(cases)), function(name) do_case(name, cases[[name]]))
+
+save_report(joboutdir)

biopipen/scripts/scrna/SeuratClusterStats-dimplots.R

@@ -5,40 +5,53 @@ 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$subset)) {
+        case$object = srtobj %>% filter(!!rlang::parse_expr(case$subset))
+    } else {
+        case$object = srtobj
+    }
+
+    if (is.null(case$group.by) && !is.null(case$ident)) {
+        case$group.by = case$ident
+    }
+
+    n_uidents = length(unique(case$object@meta.data[[case$group.by]]))
     if (is.null(case$cols)) {
-        case$cols = pal_ucscgb()(26)
+        case$cols = pal_biopipen()(n_uidents)
     }
 
-    excluded_args = c("devpars", "ident")
+    excluded_args = c("devpars", "ident", "subset")
     for (arg in excluded_args) {
         assign(arg, case[[arg]])
         case[[arg]] = NULL
     }
 
-    if (is.null(case$group.by) && !is.null(ident)) {
-        case$group.by = ident
-    }
-
     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]])
+    figfile = file.path(odir, paste0(slugify(name), ".dim.png"))
     png(figfile, width=devpars$width, height=devpars$height, res=devpars$res)
     p = do_call(DimPlot, case)
     print(p)
     dev.off()
+
+    add_report(
+        list(
+            kind = "descr",
+            content = paste0("Dimensionality reduction plot for ", case$group.by)
+        ),
+        list(
+            kind = "image",
+            src = figfile
+        ),
+        h1 = name
+    )
 }
 
 sapply(names(dimplots), do_one_dimplot)
-.save_toc()