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

biopipen/scripts/gene/GeneNameConversion.R

@@ -0,0 +1,67 @@
+library(biopipen.utils)
+
+infile <- {{in.infile | r}}
+outfile <- {{out.outfile | r}}
+notfound <- {{envs.notfound | r}}
+genecol <- {{envs.genecol | r}}
+output <- {{envs.output | r}}
+dup <- {{envs.dup | r}}
+infmt <- {{envs.infmt | r}}
+outfmt <- {{envs.outfmt | r}}
+species <- {{envs.species | r}}
+
+log <- get_logger()
+
+if (is.na(notfound)) {
+    notfound = "na"
+}
+
+df <- read.table(infile, header=TRUE, sep="\t", check.names=FALSE)
+
+if (genecol == 0) {
+    log$warn("envs.genecol should be 1-based, but 0 was given. Using 1 instead.")
+    genecol <- 1
+}
+
+if (is.numeric(genecol)) { genecol <- colnames(df)[genecol] }
+if (dup == "combine") { dup <- ";" }
+
+genes <- df[[genecol]]
+converted <- gene_name_conversion(
+    genes = genes,
+    species = species,
+    infmt = infmt,
+    outfmt = outfmt,
+    notfound = notfound,
+    dup = dup,
+    suppress_messages = FALSE
+)
+#    <genecol> <outfmt>
+# 1  1255_g_at   GUCA1A
+# 2    1316_at     THRA
+# 3    1320_at   PTPN21
+# 4    1294_at  MIR5193
+
+# order the converted dataframe by the original gene column
+converted <- converted[order(match(converted$query, genes)), , drop=FALSE]
+outcol <- outfmt
+
+if (notfound == "skip" || notfound == "ignore") {
+    df <- df[df[[genecol]] %in% converted$query, , drop=FALSE]
+}
+
+if (output == "append") {
+    if (outfmt %in% colnames(df)) {
+        log$warn("The output column name already exists in the input dataframe. Appending with a suffix `_1`.")
+        outcol <- paste(outfmt, "_1", sep="")
+    }
+    df[[outcol]] <- converted[[outfmt]]
+} else if (output == "replace") {
+    df[[genecol]] <- converted[[outfmt]]
+} else if (output == "with-query") {
+    df <- converted
+} else {
+    df <- converted[, outfmt, drop=FALSE]
+}
+
+write.table(df, file=outfile, sep="\t", quote=FALSE, row.names=FALSE)

biopipen/scripts/gene/GenePromoters.R

@@ -0,0 +1,61 @@
+library(rlang)
+library(rtracklayer)
+
+infile <- {{in.infile | r}}
+outfile <- {{out.outfile | r}}
+up <- {{envs.up | r}}
+down <- {{envs.down | r}}
+notfound <- {{envs.notfound | r}}
+refgene <- {{envs.refgene | r}}
+header <- {{envs.header | r}}
+genecol <- {{envs.genecol | r}}
+match_id <- {{envs.match_id | r}}
+sort_ <- {{envs.sort | r}}
+chrsize <- {{envs.chrsize | r}}
+
+down <- down %||% up
+
+refgenes <- readGFF(refgene)
+refcol <- ifelse(match_id, "gene_id", "gene_name")
+
+if (infile == "/dev/null") {
+    genes <- unique(refgenes[[refcol]])
+} else {
+    data <- read.table(infile, header=header, sep="\t", stringsAsFactors=FALSE, check.names=FALSE)
+    genes <- data[[genecol]]
+    rm(data)
+}
+
+notfound_genes <- setdiff(genes, refgenes[[refcol]])
+if (notfound == "error" && length(notfound_genes) > 0) {
+    stop(paste(
+        "The following genes were not found in the reference annotation:",
+        paste(notfound_genes, collapse=", ")
+    ))
+} else if (notfound == 'skip') {
+    genes <- genes[!genes %in% notfound_genes]
+}
+
+# Select the genes that are in the reference annotation and keep the order
+# of the records in genes
+refgenes <- refgenes[match(genes, refgenes[[refcol]]), , drop = FALSE]
+refgenes <- unique(makeGRangesFromDataFrame(refgenes, keep.extra.columns=TRUE))
+
+proms <- promoters(refgenes, up=up, down=down)
+# Scores must be non-NA numeric values
+elementMetadata(proms)$name <- elementMetadata(proms)[[refcol]]
+score(proms) <- 0
+start(proms) <- pmax(1, start(proms))
+
+if (sort_) {
+    chrom_sizes <- read.table(chrsize, header=FALSE, stringsAsFactors=FALSE, sep="\t")
+    common_chroms <- intersect(chrom_sizes$V1, seqlevels(proms))
+    if (length(common_chroms) == 0) {
+        stop("No common chromosomes found between the promoters and the chromosome sizes. Do you use the correct chromosome sizes file?")
+    }
+    proms <- keepSeqlevels(proms, common_chroms, pruning.mode="coarse")
+    seqlevels(proms) <- common_chroms
+    proms <- sort(proms, ignore.strand = TRUE)
+}
+
+export.bed(proms, outfile)

biopipen/scripts/gsea/Enrichr.R

@@ -1,9 +1,9 @@
-source("{{biopipen_dir}}/utils/io.R")
-source("{{biopipen_dir}}/utils/gene.R")
-source("{{biopipen_dir}}/utils/gsea.R")
+{{ biopipen_dir | joinpaths: "utils", "io.R" | source_r }}
+{{ biopipen_dir | joinpaths: "utils", "gene.R" | source_r }}
+{{ biopipen_dir | joinpaths: "utils", "gsea.R" | source_r }}
 
-infile = {{in.infile | quote}}
-outdir = {{out.outdir | quote}}
+infile = {{in.infile | r}}
+outdir = {{out.outdir | r}}
 genecol = {{envs.genecol | r}}
 genename = {{envs.genename | r}}
 dbs = {{envs.dbs | r}}

biopipen/scripts/gsea/FGSEA.R

@@ -1,58 +1,192 @@
-# PreRank the genes for GSEA analysis
-# See: https://gseapy.readthedocs.io/en/latest/_modules/gseapy/algorithm.html#ranking_metric
-source("{{biopipen_dir}}/utils/io.R")
-source("{{biopipen_dir}}/utils/gsea.R")
-
-infile = {{in.infile | quote}}
-metafile = {{in.metafile | quote}}
-gmtfile = {{in.gmtfile | quote}}
-{% if in.configfile %}
-config = {{in.config | read | toml_loads | r}}
-{% else %}
-config = list()
-{% endif %}
-outdir = {{out.outdir | quote}}
-envs = {{envs | r}}
-clscol <- if (is.null(config$clscol)) envs$clscol else config$clscol
-classes <- if (is.null(config$classes)) envs$classes else config$classes
-
-if (is.null(clscol)) {
-    stop("No `clscol` specified.")
-}
+library(rlang)
+library(biopipen.utils)
 
-if (is.null(classes) || length(classes) != 2) {
-    stop(paste("`classes` must be a pair of labels."))
-}
+# input & output
+infile = {{in.infile | r}}
+metafile = {{in.metafile | r}}
+outdir = {{out.outdir | r}}
+joboutdir = {{job.outdir | r}}
+
+# envs
+ncores = {{envs.ncores | r}}
+case = {{envs.case | r}}
+control = {{envs.control | r}}
+gmtfile = {{envs.gmtfile | r}}
+method = {{envs.method | r}}
+clscol = {{envs.clscol | r}}
+top = {{envs.top | r}}
+eps = {{envs.eps | r}}
+minsize = {{envs.minSize | default: envs.minsize | r}}
+maxsize = {{envs.maxSize | default: envs.maxsize | r}}
+rest = {{envs.rest | r}}
+cases = {{envs.cases | r}}
+
+log <- get_logger()
+reporter <- get_reporter()
+
+defaults <- list(
+    case = case,
+    control = control,
+    gmtfile = gmtfile,
+    method = method,
+    clscol = clscol,
+    top = top,
+    eps = eps,
+    minsize = minsize,
+    maxsize = maxsize,
+    rest = rest
+)
+cases <- expand_cases(cases, defaults, default_case = "GSEA")
+
+log$info("Reading input file ...")
+indata <- read.table(infile, header=TRUE, stringsAsFactors=FALSE, row.names=1, sep="\t", quote="", check.names=FALSE)
 
-if (is.character(envs$inopts) && inopts == "rds") {
-    indata = readRDS(infile)
+if (!is.null(metafile)) {
+    log$info("Reading metadata file ...")
+    metadata <- read.table(metafile, header=TRUE, stringsAsFactors=FALSE, row.names=NULL, sep="\t", quote="", check.names=FALSE)
 } else {
-    indata = read.table.opts(infile, envs$inopts)
+    metadata <- NULL
 }
 
-metadata = read.table.opts(metafile, envs$metaopts)
-allclasses = metadata[colnames(indata), clscol]
+do_case <- function(name) {
+    log$info("Processing case: {name} ...")
+    case <- cases[[name]]
+    info <- case_info(name, outdir, create = TRUE)
 
-ranks = prerank(indata, classes[1], classes[2], allclasses, envs$method)
+    if (is.null(case$case) && is.null(case$control)) {
+        stop("Either `case` or `control` must be specified in the case.")
+    }
+    if (is.null(case$gmtfile)) {
+        stop("`gmtfile` must be specified in the case.")
+    }
+    if (is.null(case$clscol)) {
+        stop("`clscol` must be specified in the case.")
+    }
+    if (!is.null(metadata) && length(case$clscol) > 1) {
+        stop("When `in.metafile` is specified, `envs.clscol` must be a single column name.")
+    }
+    if (!is.null(metadata)) {
+        samples <- colnames(indata)
+        if (!"Sample" %in% colnames(metadata)) {
+            colnames(metadata)[1] <- "Sample"
+        }
+        metadata <- metadata[match(samples, metadata$Sample), , drop=FALSE]
+        case$clscol <- as.character(metadata[[case$clscol]])
+    }
+    if (length(unique(case$clscol)) < 2) {
+        stop("The `clscol` must have at least two unique values.")
+    }
+    if (length(unique(case$clscol)) == 2) {
+        case$case <- case$case %||% setdiff(unique(case$clscol), case$control)
+        case$control <- case$control %||% setdiff(unique(case$clscol), case$case)
+    } else {
+        if (is.null(case$case) || is.null(case$control)) {
+            stop("When `clscol` has more than two unique values, both `case` and `control` must be specified.")
+        }
+    }
+    log$info("- Running pre-ranking ...")
+    ranks <- RunGSEAPreRank(
+        indata,
+        classes = case$clscol,
+        case = case$case,
+        control = case$control,
+        method = case$method
+    )
+    if (all(is.na(ranks))) {
+        if (length(case$clscol) < 10) {
+            log$warn("  Ignoring this case because all gene ranks are NA and there are <10 samples.")
+            reporter$add2(
+                list(
+                    kind = "error",
+                    content = paste0("Not enough samples (n = ", length(case$clscol), ") to run fgsea.")
+                ),
+                hs = c(info$section, info$name)
+            )
+            return(NULL)
+        } else {
+            stop(paste0(
+                "All gene ranks are NA (# samples = ",
+                length(case$clscol),
+                "). ",
+                "It's probably due to high missing rate in the data. ",
+                "You may want to try a different `envs$method` for pre-ranking."
+            ))
+        }
+    }
 
-write.table(
-    ranks,
-    file.path(outdir, "fgsea.rank"),
-    row.names=F,
-    col.names=T,
-    sep="\t",
-    quote=F
-)
+    log$info("- Running GSEA ...")
+    case$rest$ranks <- ranks
+    case$rest$genesets <- ParseGMT(case$gmtfile)
+    case$rest$minSize <- case$rest$minSize %||% case$rest$minsize %||% case$minsize
+    case$rest$maxSize <- case$rest$maxSize %||% case$rest$maxsize %||% case$maxsize
+    case$rest$eps <- case$eps
+    case$rest$nproc <- case$ncores
+    case$rest$minsize <- NULL
+    case$rest$maxsize <- NULL
+    result <- do_call(RunGSEA, case$rest)
+    write.table(
+        result,
+        file.path(info$prefix, "fgsea.tsv"),
+        row.names = FALSE,
+        col.names = TRUE,
+        sep = "\t",
+        quote = FALSE
+    )
+
+    p_summary <- VizGSEA(
+        result,
+        plot_type = "summary",
+        top_term = case$top
+    )
+    save_plot(
+        p_summary,
+        file.path(info$prefix, "summary"),
+        devpars = list(res = 100, height = attr(p_summary, "height") * 100, width = attr(p_summary, "width") * 100),
+        formats = "png"
+    )
+
+    p_gsea <- VizGSEA(
+        result,
+        plot_type = "gsea",
+        gs = result$pathway[1:min(case$top, nrow(result))]
+    )
+    save_plot(
+        p_gsea,
+        file.path(info$prefix, "pathways"),
+        devpars = list(res = 100, height = attr(p_gsea, "height") * 100, width = attr(p_gsea, "width") * 100),
+        formats = "png"
+    )
+
+
+    reporter$add2(
+        list(
+            name = "Table",
+            contents = list(
+                list(kind = "descr", content = paste0(
+                    "Showing top 50 pathways by padj in descending order. ",
+                    "Use 'Download the entire data' button to download all pathways."
+                )),
+                list(kind = "table", src = file.path(info$prefix, "fgsea"), data = list(nrows = 50))
+            )
+        ),
+        list(
+            name = "Summary Plot",
+            contents = list(
+                list(kind = "descr", content = paste0("Showing top ", case$top, " pathways.")),
+                list(kind = "image", src = file.path(info$prefix, "summary.png"))
+            )
+        ),
+        list(
+            name = "GSEA Plots",
+            contents = list(
+                list(kind = "descr", content = paste0("Showing top ", case$top, " pathways.")),
+                list(kind = "image", src = file.path(info$prefix, "pathways.png"))
+            )
+        ),
+        hs = c(info$section, info$name),
+        ui = "tabs"
+    )
+}
 
-top = envs$top
-envs$nproc = envs$ncores
-envs$inopts = NULL
-envs$metaopts = NULL
-envs$method = NULL
-envs$clscol = NULL
-envs$classes = NULL
-envs$ncores = NULL
-envs$top = NULL
-# the rest are the arguments for `fgsea()`
-
-runFGSEA(ranks, gmtfile, top, outdir, envs)
+sapply(names(cases), do_case)
+reporter$save(joboutdir)

biopipen/scripts/gsea/GSEA.R

@@ -1,7 +1,7 @@
 # devtools::install_github("GSEA-MSigDB/GSEA_R")
 
-source("{{biopipen_dir}}/utils/io.R")
-source("{{biopipen_dir}}/utils/gsea.R")
+{{ biopipen_dir | joinpaths: "utils", "io.R" | source_r }}
+{{ biopipen_dir | joinpaths: "utils", "gsea.R" | source_r }}
 
 library(dplyr)
 library(tibble)

biopipen/scripts/gsea/PreRank.R

@@ -1,16 +1,16 @@
 # PreRank the genes for GSEA analysis
 # See: https://gseapy.readthedocs.io/en/latest/_modules/gseapy/algorithm.html#ranking_metric
-source("{{biopipen_dir}}/utils/io.R")
-source("{{biopipen_dir}}/utils/gsea.R")
+{{ biopipen_dir | joinpaths: "utils", "io.R" | source_r }}
+{{ biopipen_dir | joinpaths: "utils", "gsea.R" | source_r }}
 
-infile = {{in.infile | quote}}
-metafile = {{in.metafile | quote}}
+infile = {{in.infile | r}}
+metafile = {{in.metafile | r}}
 {% if in.configfile %}
 config = {{in.config | read | toml_loads | r}}
 {% else %}
 config = list()
 {% endif %}
-outfile = {{out.outfile | quote}}
+outfile = {{out.outfile | r}}
 envs = {{envs | r}}
 clscol <- if (is.null(config$clscol)) envs$clscol else config$clscol
 classes <- if (is.null(config$classes)) envs$classes else config$classes

biopipen/scripts/misc/Config2File.py

@@ -1,8 +1,8 @@
 import json
 import rtoml
 
-configstr = {{in.config | repr}}  # pyright: ignore
-outfile = {{out.outfile | quote}}  # pyright: ignore
+configstr: str = {{in.config | quote}}  # pyright: ignore  # noqa
+outfile: str = {{out.outfile | quote}}  # pyright: ignore
 infmt = {{envs.infmt | quote}}  # pyright: ignore
 outfmt = {{envs.outfmt | quote}}  # pyright: ignore
 

biopipen/scripts/misc/Plot.R

@@ -0,0 +1,80 @@
+library(gglogger)
+library(plotthis)
+library(rlang)
+library(biopipen.utils)
+
+datafile <- {{in.datafile | r}}
+plotfile <- {{out.plotfile | r}}
+plotprefix <- {{out.plotfile | prefix | r}}
+read_opts <- {{envs.read_opts | r: todot="-"}}
+envs <- {{envs | r}}
+
+fn <- envs$fn
+envs$fn <- NULL
+devpars <- envs$devpars
+envs$devpars <- NULL
+more_formats <- envs$more_formats
+envs$more_formats <- NULL
+save_code <- envs$save_code
+envs$save_code <- NULL
+envs$read_opts <- NULL
+
+if (endsWith(datafile, ".qs") || endsWith(datafile, ".qs2") ||
+    endsWith(datafile, ".rds") || endsWith(datafile, ".RDS")) {
+    envs$data <- read_obj(datafile)
+} else {
+    read_opts <- read_opts %||% list()
+    read_opts$file <- datafile
+    envs$data <- do.call(read.table, read_opts)
+}
+
+if (fn == "ManhattanPlot" && !is.null(envs$chromosomes)) {
+    norm_chroms <- function(chrs) {
+        chrs <- as.character(chrs)
+        if (length(chrs) == 1 && grepl(",", chrs)) {
+            chrs <- trimws(unlist(strsplit(chrs, ",")))
+        }
+        if (length(chrs) > 1) {
+            return(unique(unlist(sapply(chrs, function(chr) norm_chroms(chr)))))
+        }
+        if (!grepl("-", chrs)) { return(chrs) }
+
+        # expand chr1-22 -> chr1, chr2, ..., chr22
+        # chr1-22 -> 'chr1', '22'
+        chrs <- unlist(strsplit(chrs, "-"))
+        if (length(chrs) != 2) {
+            stop(paste0("Invalid chroms: ", chrs))
+        }
+        # detect prefix
+        prefix1 <- gsub("[0-9]", "", chrs[1])
+        prefix2 <- gsub("[0-9]", "", chrs[2])
+        if (nchar(prefix2) > 0 && prefix1 != prefix2) {
+            stop(paste0("Invalid chroms: ", chrs, " (prefix mismatch)"))
+        }
+        chr_a <- as.integer(substring(chrs[1], nchar(prefix1) + 1))
+        chr_b <- as.integer(substring(chrs[2], nchar(prefix2) + 1))
+        chr_min <- min(chr_a, chr_b)
+        chr_max <- max(chr_a, chr_b)
+        return(paste0(prefix1, chr_min:chr_max))
+    }
+
+    envs$chromosomes <- norm_chroms(envs$chromosomes)
+}
+
+plotfn <- utils::getFromNamespace(fn, "plotthis")
+if (save_code) {
+    plotfn <- gglogger::register(plotfn, name = fn)
+}
+
+p <- do_call(plotfn, envs)
+save_plot(p, plotprefix, devpars, formats = unique(c("png", more_formats)))
+
+if (save_code) {
+    save_plotcode(
+        p,
+        setup = c('library(plotthis)', '', 'load("data.RData")', 'list2env(envs, envir = .GlobalEnv)'),
+        prefix = plotprefix,
+        "envs",
+        auto_data_setup = FALSE
+    )
+}

biopipen/scripts/misc/Shell.sh

@@ -0,0 +1,15 @@
+# shellcheck disable=all
+export infile={{in.infile | quote}}
+export outfile={{out.outfile | quote}}
+is_outdir={{envs.outdir | int}}
+cmd_given={{envs.cmd | bool | int}}
+{% set _ = out.outfile | dirname | joinpath: "cmd.sh" | as_path | attr: 'write_text' | call: envs.cmd %}
+cmd="{{proc.lang}} {{out.outfile | dirname | joinpath: 'cmd.sh'}}"
+if [[ "$cmd_given" -eq 0 ]]; then
+    echo "No command given." 1>&2
+    exit 1
+fi
+if [[ $is_outdir -eq 1 ]]; then
+    mkdir -p "$outfile"
+fi
+eval "$cmd"

biopipen/scripts/misc/Str2File.py

@@ -1,6 +1,6 @@
-instr = {{in.str | repr}}  # pyright: ignore
+instr: str = {{in.str | quote}}  # pyright: ignore  # noqa
 name = {{repr(in.name or envs.name)}}  # pyright: ignore
-outfile = {{out.outfile | quote}}  # pyright: ignore
+outfile: str = {{out.outfile | quote}}  # pyright: ignore
 
 with open(outfile, "wt") as fout:
     fout.write(instr)

biopipen/scripts/plot/Heatmap.R

@@ -1,6 +1,6 @@
-source("{{biopipen_dir}}/utils/io.R")
-source("{{biopipen_dir}}/utils/misc.R")
-source("{{biopipen_dir}}/utils/plot.R")
+{{ biopipen_dir | joinpaths: "utils", "io.R" | source_r }}
+{{ biopipen_dir | joinpaths: "utils", "misc.R" | source_r }}
+{{ biopipen_dir | joinpaths: "utils", "plot.R" | source_r }}
 
 # to compile the expressions
 library(ComplexHeatmap)