biopipen 0.31.4__py3-none-any.whl → 0.31.6__py3-none-any.whl

biopipen/scripts/protein/ProdigySummary.R

@@ -0,0 +1,133 @@
+{{ biopipen_dir | joinpaths: "utils", "misc.R" | source_r }}
+
+library(rlang)
+library(dplyr)
+library(ggplot2)
+library(ggprism)
+
+theme_set(theme_prism())
+
+infiles <- {{in.infiles | r}}
+outdir <- {{out.outdir | r}}
+joboutdir <- {{job.outdir | r}}
+group <- {{envs.group | r}}
+
+if (is.character(group)) {
+    group <- read.csv(group, header = FALSE, row.names = NULL)
+    colnames(group) <- c("Sample", "Group")
+} else if (is.list(group)) {
+    group <- do_call(
+        rbind,
+        lapply(names(group), function(n) data.frame(Sample = group[[n]], Group = n))
+    )
+} else if (!is.null(group)) {
+    stop(paste0("Invalid group: ", paste0(group, collapse = ", ")))
+}
+
+log_info("Reading and merging metrics for each sample ...")
+metrics <- NULL
+
+for (infile in infiles) {
+    sample <- sub("_prodigy$", "", basename(dirname(infile)))
+    log_debug("- Reading metrics from {sample}")
+    metric <- read.table(
+        infile,
+        header = TRUE,
+        sep = "\t",
+        stringsAsFactors = FALSE,
+        check.names = FALSE,
+        row.names = NULL)
+    metric$Sample <- sample
+    metric <- metric %>% select(Sample, everything())
+    if (is.null(metrics)) {
+        metrics <- metric
+    } else {
+        metrics <- rbind(metrics, metric)
+    }
+}
+
+# Save metrics
+write.table(
+    metrics,
+    file.path(outdir, "metrics.txt"),
+    sep = "\t",
+    quote = FALSE,
+    row.names = FALSE
+)
+
+add_report(
+    list(kind = "descr", content = "Metrics for all samples"),
+    list(kind = "table", src = file.path(outdir, "metrics.txt")),
+    h1 = "Metrics of all samples"
+)
+
+METRIC_DESCR = list(
+    nIC = "No. of intermolecular contacts",
+    nCCC = "No. of charged-charged contacts",
+    nCPC = "No. of charged-polar contacts",
+    nCAPC = "No. of charged-apolar contacts",
+    nPPC = "No. of polar-polar contacts",
+    nAPPC = "No. of apolar-polar contacts",
+    nAPAPC = "No. of apolar-apolar contacts",
+    pANISR = "Percentage of apolar NIS residues",
+    pCNISR = "Percentage of charged NIS residues",
+    BindingAffinity = "Predicted binding affinity (kcal.mol^-1)",
+    DissociationConstant = "Predicted dissociation constant (M)"
+)
+
+if (!is.null(group)) {
+    log_info("Merging group information ...")
+    metrics <- group %>%
+        left_join(metrics, by = "Sample") %>%
+        mutate(Group = factor(Group, levels = unique(Group)))
+}
+
+log_info("Plotting Prodigy metrics ...")
+for (metric in names(METRIC_DESCR)) {
+    log_info("- {metric}: {METRIC_DESCR[[metric]]}")
+
+    add_report(
+        list(
+            kind = "descr",
+            content = METRIC_DESCR[[metric]] %||% paste0("Metric: ", metric)
+        ),
+        h1 = metric
+    )
+
+    # barplot
+    p <- ggplot(metrics, aes(x = Sample, y = !!sym(metric))) +
+        geom_bar(stat = "identity", fill = "steelblue") +
+        labs(x = "Sample", y = metric) +
+        theme(axis.text.x = element_text(angle = 90, hjust = 1))
+
+    figfile <- file.path(outdir, paste0(slugify(metric), ".barplot.png"))
+    png(figfile, height = 600, res = 100, width = nrow(metrics) * 30 + 200)
+    print(p)
+    dev.off()
+
+    add_report(
+        list(src = figfile, name = "By Sample"),
+        ui = "table_of_images",
+        h1 = metric
+    )
+
+    if (is.null(group)) { next }
+    # group: Sample, Group
+    p <- ggplot(metrics, aes(x = Group, y = !!sym(metric))) +
+        geom_boxplot(fill = "steelblue") +
+        labs(x = "Group", y = metric) +
+        theme(axis.text.x = element_text(angle = 90, hjust = 1))
+
+    figfile <- file.path(outdir, paste0(slugify(metric), ".boxplot.png"))
+    png(figfile, height = 600, res = 100, width = length(unique(metrics$Group)) * 30 + 200)
+    print(p)
+    dev.off()
+
+    add_report(
+        list(src = figfile, name = "By Group"),
+        ui = "table_of_images",
+        h1 = metric
+    )
+}
+
+save_report(joboutdir)

biopipen/scripts/regulatory/MotifAffinityTest.R

@@ -1,9 +1,9 @@
 # Script for regulatory.MotifAffinityTest
 {{ biopipen_dir | joinpaths: "utils", "misc.R" | source_r }}
+{{ biopipen_dir | joinpaths: "scripts", "regulatory", "motifs-common.R" | source_r }}
 
 library(BiocParallel)
 library(BSgenome)
-library(universalmotif)
 
 motiffile <- {{in.motiffile | r}}
 varfile <- {{in.varfile | r}}
@@ -45,63 +45,9 @@ if (is.null(motif_col) && is.null(regulator_col)) {
 log_info("Reading input regulator/motif file ...")
 in_motifs <- read.table(motiffile, header=TRUE, sep="\t", stringsAsFactors=FALSE, check.names = FALSE)
 
-if (is.null(motif_col)) {
-    log_info("Inferring motifs from regulators ...")
-    if (is.null(regmotifs) || !file.exists(regmotifs)) {
-        stop("Regulator motifs (envs.regmotifs) is required and must exist when no motif column (envs.motif_col) is provided")
-    }
-    regmotifs <- read.table(regmotifs, header=TRUE, sep="\t", stringsAsFactors=FALSE, check.names = FALSE)
-    rm_motif_col <- c('Motif', 'motif', 'MOTIF', 'Model', 'model', 'MODEL')
-    rm_reg_col <- c('Regulator', 'regulator', 'REGULATOR', 'TF', 'tf', 'TF', 'Transcription factor', 'transcription factor', 'Transcription Factor')
-    rm_motif_col <- intersect(rm_motif_col, colnames(regmotifs))
-    rm_reg_col <- intersect(rm_reg_col, colnames(regmotifs))
-    if (length(rm_motif_col) == 0) {
-        stop("No motif column found in envs.regmotifs, provide one of: ", paste(rm_motif_col, collapse = ", "))
-    }
-    if (length(rm_reg_col) == 0) {
-        stop("No regulator column found in envs.regmotifs, provide one of: ", paste(rm_reg_col, collapse = ", "))
-    }
-    rm_motif_col <- rm_motif_col[1]
-    rm_reg_col <- rm_reg_col[1]
-    # check regulators
-    rm_regs <- regmotifs[, rm_reg_col, drop = TRUE]
-    regulators <- in_motifs[, regulator_col, drop = TRUE]
-    notfound_regs <- setdiff(regulators, rm_regs)
-    if (length(notfound_regs) > 0 && notfound == "error") {
-        first_notfound <- head(notfound_regs, 3)
-        if (length(notfound_regs) > 3) {
-            first_notfound <- c(first_notfound, "...")
-            notfound_file <- file.path(outdir, "notfound_regulators.txt")
-            writeLines(notfound_regs, notfound_file)
-            msg1 <- paste0("The following regulators were not found in the envs.regmotifs file: ", paste(first_notfound, collapse = ", "))
-            msg2 <- paste0("Check the full list in ", notfound_file)
-            stop(msg1, "\n", msg2)
-        } else {
-            msg <- paste0("The following regulators were not found in the regmotifs file: ", paste(first_notfound, collapse = ", "))
-            stop(msg)
-        }
-    }
-    in_motifs <- in_motifs[in_motifs[, regulator_col] %in% rm_regs, , drop = FALSE]
-    # add motif column
-    in_motifs <- merge(in_motifs, regmotifs, by.x = regulator_col, by.y = rm_reg_col, all.x = TRUE, suffixes = c("", "_db"))
-    motif_col <- rm_motif_col
-}
-if (is.null(regulator_col)) {
-    # make motifs unique
-    in_moitfs <- in_motifs[!duplicated(in_motifs[, motif_col]), , drop = FALSE]
-} else {
-    in_motifs <- in_motifs[!duplicated(in_motifs[, c(regulator_col, motif_col)]), , drop = FALSE]
-}
-
-
-if (!grepl(".", genome, fixed = TRUE)) {
-    genome_pkg = sprintf("BSgenome.Hsapiens.UCSC.%s", genome)
-} else {
-    genome_pkg = genome
-}
-if (!requireNamespace(genome_pkg, quietly = TRUE)) {
-    stop(sprintf("Genome package %s is not installed", genome_pkg))
-}
+log_info("Ensuring motifs and regulators in the input data ...")
+in_motifs <- ensure_regulator_motifs(in_motifs, outdir, motif_col, regulator_col, regmotifs, notfound = notfound)
+genome_pkg <- get_genome_pkg(genome)
 
 log_info("Reading variant file ...")
 if (grepl("\\.vcf$", varfile) || grepl("\\.vcf\\.gz$", varfile)) {
@@ -124,91 +70,7 @@ snpinfo <- read.table(varfile, header=FALSE, stringsAsFactors=FALSE)
 colnames(snpinfo) <- c("chrom", "start", "end", "name", "score", "strand", "ref", "alt")
 
 log_info("Reading motif database ...")
-meme <- read_meme(motifdb)
-
-check_motifs <- function(motifdb_names) {
-    motifs <- in_motifs[, motif_col, drop = TRUE]
-    notfound_motifs <- setdiff(motifs, motifdb_names)
-    if (length(notfound_motifs) > 0) {
-        first_notfound <- head(notfound_motifs, 3)
-        if (length(notfound_motifs) > 3) {
-            first_notfound <- c(first_notfound, "...")
-            notfound_file <- file.path(outdir, "notfound_motifs.txt")
-            writeLines(notfound_motifs, notfound_file)
-            msg1 <- paste0("The following motifs were not found in the motif database: ", paste(first_notfound, collapse = ", "))
-            msg2 <- paste0("Check the full list in ", notfound_file)
-
-            if (notfound == "error") {
-                stop(msg1, "\n", msg2)
-            } else if (notfound == "ignore") {
-                log_warn(msg1)
-                log_warn(msg2)
-            }
-        } else {
-            msg <- paste0("The following motifs were not found in the motif database: ", paste(first_notfound, collapse = ", "))
-            if (notfound == "error") {
-                stop(msg)
-            } else if (notfound == "ignore") {
-                log_warn(msg)
-            }
-        }
-
-        motifs <- setdiff(motifs, notfound_motifs)
-    }
-    return(motifs)
-}
-
-plot_variant <- function(motifbreakr_results) {
-    log_info("Plotting variants ...")
-    plotdir <- file.path(outdir, "plots")
-    dir.create(plotdir, showWarnings = FALSE)
-    results <- motifbreakr_results
-    if (is.null(plots) || length(plots) == 0) {
-        results <- results[order(-abs(results$alleleDiff)), , drop = FALSE]
-        results <- results[1:min(plot_nvars, length(results)), , drop = FALSE]
-        variants <- unique(results$SNP_id)
-    } else {
-        variants <- names(plots)
-    }
-    for (variant in variants) {
-        log_info("- Variant: {variant}")
-        if (is.null(plots[[variant]])) {
-            plots[[variant]] <- list(devpars = devpars, which = "TRUE")
-        }
-        if (is.null(plots[[variant]]$which)) {
-            plots[[variant]]$which <- "TRUE"
-        }
-        if (is.null(plots[[variant]]$devpars)) {
-            plots[[variant]]$devpars <- devpars
-        }
-        if (is.null(plots[[variant]]$devpars$res)) {
-            plots[[variant]]$devpars$res <- 100
-        }
-        res <- results[results$SNP_id == variant, , drop = FALSE]
-        if (length(res) == 0) {
-            stop(sprintf("Variant %s not found in results", variant))
-        }
-        res <- subset(res, subset = eval(parse(text = plots[[variant]]$which)))
-        if (length(res) == 0) {
-            stop(sprintf("No variants to plot for %s", variant))
-        }
-        plotfile <- file.path(plotdir, sprintf("%s.png", slugify(variant)))
-        # fix motifBreakR 2.12 using names to filter in plotMB
-        names(res) <- res$SNP_id
-        dv <- plots[[variant]]$devpars
-        if (is.null(dv$height)) {
-            dv$height <- 2.4 * dv$res + length(res) * 1.2 * dv$res
-        }
-        if (is.null(dv$width)) {
-            left <- min(sapply(res$motifPos, `[`, 1))
-            right <- max(sapply(res$motifPos, `[`, 2))
-            dv$width <- 1.5 * dv$res + (right - left) * 0.3 * dv$res
-        }
-        png(plotfile, width = dv$width, height = dv$height, res = dv$res)
-        motifbreakR::plotMB(res, variant)
-        dev.off()
-    }
-}
+mdb <- read_meme_to_motifdb(motifdb, in_motifs, motif_col, regulator_col, notfound, outdir)
 
 tool <- tolower(tool)
 tool <- match.arg(tool, c("motifbreakr", "atsnp"))

biopipen/scripts/regulatory/MotifAffinityTest_AtSNP.R

@@ -1,36 +1,6 @@
 library(atSNP)
 library(rtracklayer)
 
-log_info("Converting universalmotif object to motif_library ...")
-
-motifdb_names <- sapply(meme, function(m) m@name)
-motifs <- check_motifs(motifdb_names)
-meme <- filter_motifs(meme, name = motifs)
-# Get the right order of motif names
-motifs <- sapply(meme, function(m) m@name)
-
-# used for atSNP
-mdb <- lapply(meme, function(m) t(m@motif))
-names(mdb) <- motifs
-
-# compose one used for plotting using motifbreakR
-motifdb_matrices <- lapply(meme, function(m) m@motif)
-names(motifdb_matrices) <- motifs
-motifdb_meta <- do.call(rbind, lapply(meme, function(m) {
-    ats <- attributes(m)
-    ats$dataSource <- basename(motifdb)
-    ats$class <- NULL
-    ats$motif <- NULL
-    ats$gapinfo <- NULL
-    ats$sequenceCount <- ats$nsites
-    ats$providerId <- ats$name
-    ats$providerName <- ats$name
-    ats$organism <- if (is.null(ats$organism) || length(ats$organism) == 0) "Unknown" else ats$organism
-    unlist(ats)
-}))
-rownames(motifdb_meta) <- motifs
-pmotifs <- MotifDb:::MotifList(motifdb_matrices, tbl.metadata = motifdb_meta)
-
 log_info("Converting snpinfo to atSNP object ...")
 
 # c("chrom", "start", "end", "name", "score", "strand", "ref", "alt", "ref_seq", "alt_seq")
@@ -53,7 +23,9 @@ write.table(
     file = atsnp_bed,
     sep = "\t", quote = FALSE, row.names = FALSE, col.names = TRUE
 )
-k <- max(sapply(mdb, nrow))
+
+motif_lib <- motifdb_to_motiflib(mdb)
+k <- max(sapply(motif_lib, nrow))
 snps <- LoadSNPData(
     atsnp_bed,
     genome.lib = genome_pkg,
@@ -62,13 +34,12 @@ snps <- LoadSNPData(
     half.window.size = k
 )
 
-# run motifbreakR
 log_info("Running atSNP ...")
-atsnp_scores <- ComputeMotifScore(mdb, snps, ncores = ncores)
+atsnp_scores <- ComputeMotifScore(motif_lib, snps, ncores = ncores)
 
 log_info("Calculating p values ...")
 atsnp_result <- ComputePValues(
-    motif.lib = mdb,
+    motif.lib = motif_lib,
     snp.info = snps,
     motif.scores = atsnp_scores$motif.scores,
     ncores = ncores,
@@ -101,7 +72,7 @@ atsnp_result$motifPos <- sapply(1:nrow(atsnp_result), function(i) {
     paste(c(atsnp_result$ref_start[i] - k, atsnp_result$ref_end[i] - k), collapse = ",")
 })
 if (!is.null(regulator_col)) {
-    atsnp_result$Regulator <- in_motifs[
+    atsnp_result$geneSymbol <- atsnp_result$Regulator <- in_motifs[
         match(atsnp_result$providerId, in_motifs[[motif_col]]),
         regulator_col,
         drop = TRUE
@@ -120,7 +91,30 @@ atsnp_result$alleleDiff <- -atsnp_result[[cutoff_col]]
 atsnp_result$effect <- "strong"
 atsnp_result$motifPos <- lapply(atsnp_result$motifPos, function(x) as.integer(unlist(strsplit(x, ","))))
 atsnp_result <- makeGRangesFromDataFrame(atsnp_result, keep.extra.columns = TRUE, starts.in.df.are.0based = TRUE)
+genome(atsnp_result) <- genome
 attributes(atsnp_result)$genome.package <- genome_pkg
-attributes(atsnp_result)$motifs <- pmotifs
+attributes(atsnp_result)$motifs <- mdb
+
+if (is.null(plots) || length(plots) == 0) {
+    atsnp_result <- atsnp_result[order(-abs(atsnp_result$alleleDiff)), , drop = FALSE]
+    atsnp_result <- atsnp_result[1:min(plot_nvars, length(atsnp_result)), , drop = FALSE]
+    variants <- unique(atsnp_result$SNP_id)
+} else {
+    variants <- names(plots)
+}
+for (variant in variants) {
+    log_info("- Variant: {variant}")
+    if (is.null(plots[[variant]])) {
+        plots[[variant]] <- list(devpars = devpars, which = "TRUE")
+    }
+    if (is.null(plots[[variant]]$which)) {
+        plots[[variant]]$which <- "TRUE"
+    }
+    if (is.null(plots[[variant]]$devpars)) {
+        plots[[variant]]$devpars <- devpars
+    }
+    res <- atsnp_result[atsnp_result$SNP_id == variant, , drop = FALSE]
+    res <- subset(res, subset = eval(parse(text = plots[[variant]]$which)))
 
-plot_variant(atsnp_result)
+    plot_variant_motifs(res, variant, plots[[variant]]$devpars, outdir)
+}

biopipen/scripts/regulatory/MotifAffinityTest_MotifBreakR.R

@@ -1,30 +1,6 @@
 library(motifbreakR)
-bsgenome <- getBSgenome(genome_pkg)
-
-log_info("Converting universalmotif object to MotifDb object ...")
-
-motifdb_names <- sapply(meme, function(m) m@name)
-motifs <- check_motifs(motifdb_names)
-meme <- filter_motifs(meme, name = motifs)
-# Get the right order of motif names
-motifs <- sapply(meme, function(m) m@name)
-motifdb_matrices <- lapply(meme, function(m) m@motif)
-names(motifdb_matrices) <- motifs
 
-motifdb_meta <- do.call(rbind, lapply(meme, function(m) {
-    ats <- attributes(m)
-    ats$dataSource <- basename(motifdb)
-    ats$class <- NULL
-    ats$motif <- NULL
-    ats$gapinfo <- NULL
-    ats$sequenceCount <- ats$nsites
-    ats$providerId <- ats$name
-    ats$providerName <- ats$name
-    ats$organism <- if (is.null(ats$organism) || length(ats$organism) == 0) "Unknown" else ats$organism
-    unlist(ats)
-}))
-rownames(motifdb_meta) <- motifs
-mdb <- MotifDb:::MotifList(motifdb_matrices, tbl.metadata = motifdb_meta)
+bsgenome <- getBSgenome(genome_pkg)
 
 # `chrom`, `start`, `end`, `name`, `score`, `strand`, `ref`, `alt`.
 is_indel <- nchar(snpinfo$ref) != 1 | nchar(snpinfo$alt) != 1
@@ -93,4 +69,27 @@ write.table(
 )
 rm(results_to_save)
 
-plot_variant(results)
+log_info("Plotting variants ...")
+if (is.null(plots) || length(plots) == 0) {
+    results <- results[order(-abs(results$alleleDiff)), , drop = FALSE]
+    results <- results[1:min(plot_nvars, length(results)), , drop = FALSE]
+    variants <- unique(results$SNP_id)
+} else {
+    variants <- names(plots)
+}
+for (variant in variants) {
+    log_info("- Variant: {variant}")
+    if (is.null(plots[[variant]])) {
+        plots[[variant]] <- list(devpars = devpars, which = "TRUE")
+    }
+    if (is.null(plots[[variant]]$which)) {
+        plots[[variant]]$which <- "TRUE"
+    }
+    if (is.null(plots[[variant]]$devpars)) {
+        plots[[variant]]$devpars <- devpars
+    }
+    res <- results[results$SNP_id == variant, , drop = FALSE]
+    res <- subset(res, subset = eval(parse(text = plots[[variant]]$which)))
+
+    plot_variant_motifs(res, variant, plots[[variant]]$devpars, outdir)
+}

biopipen/scripts/regulatory/VariantMotifPlot.R

@@ -0,0 +1,76 @@
+{{ biopipen_dir | joinpaths: "utils", "misc.R" | source_r }}
+{{ biopipen_dir | joinpaths: "scripts", "regulatory", "motifs-common.R" | source_r }}
+
+library(BSgenome)
+library(GenomicRanges)
+
+infile <- {{in.infile | r}}
+outdir <- {{out.outdir | r}}
+genome <- {{envs.genome | r}}
+motifdb <- {{envs.motifdb | r}}
+motif_col <- {{envs.motif_col | r}}
+regulator_col <- {{envs.regulator_col | r}}
+regmotifs <- {{envs.regmotifs | r}}
+notfound <- {{envs.notfound | r}}
+devpars <- {{envs.devpars | r}}
+plot_vars <- {{envs.plot_vars | r}}
+
+if (is.null(motifdb) || !file.exists(motifdb)) {
+    stop("Motif database (envs.motifdb) is required and must exist")
+}
+
+if (is.null(genome)) {
+    stop("Reference genome (envs.ref) is required and must exist")
+}
+
+if (is.null(motif_col) && is.null(regulator_col)) {
+    stop("Either motif (envs.motif_col) or regulator (envs.regulator_col) column must be provided")
+}
+
+log_info("Reading input data ...")
+indata <- read.table(infile, header=TRUE, sep="\t", stringsAsFactors=FALSE, check.names = FALSE)
+
+log_info("Ensuring regulators in the input data ...")
+indata <- ensure_regulator_motifs(indata, outdir, motif_col, regulator_col, regmotifs, notfound = notfound)
+genome_pkg <- get_genome_pkg(genome)
+
+log_info("Reading motif database ...")
+meme <- read_meme_to_motifdb(motifdb, indata, motif_col, regulator_col, notfound, outdir)
+
+log_info("Composing motifbreakR results from input data ...")
+indata$chr <- indata$chrom %||% indata$chr %||% indata$seqnames
+indata$seqnames <- NULL
+indata$strand <- indata$strand %||% "+"
+indata$varType <- indata$varType %||% "SNV"
+indata$geneSymbol <- indata$geneSymbol %||% indata$Regulator
+indata$providerId <- indata$providerId %||% indata$motif
+indata$providerName <- indata$providerName %||% indata$providerId
+indata$dataSource <- indata$dataSource %||% strsplit(basename(motifdb), "\\.")[[1]][1]
+indata$effect <- indata$effect %||% "strong"
+indata$altPos <- indata$altPos %||% 1
+indata$alleleDiff <- indata$alleleDiff %||% indata$score %||% 0
+
+# check other required columns
+for (col in c("start", "end", "SNP_id", "REF", "ALT", "motifPos")) {
+    if (!(col %in% colnames(indata))) {
+        stop("Column '", col, "' is required in the input data")
+    }
+}
+indata$motifPos <- lapply(indata$motifPos, function(x) as.integer(unlist(strsplit(x, ","))))
+indata <- makeGRangesFromDataFrame(indata, keep.extra.columns = TRUE, starts.in.df.are.0based = TRUE)
+genome(indata) <- genome
+attributes(indata)$genome.package <- genome_pkg
+attributes(indata)$motifs <- meme
+
+log_info("Plotting variants ...")
+if (is.null(plot_vars)) {
+    plot_vars <- unique(indata$SNP_id)
+} else if (length(plot_vars) > 1) {
+    plot_vars <- unique(plot_vars)
+} else {
+    plot_vars <- strsplit(plot_vars, ",")[[1]]
+}
+for (pvar in plot_vars) {
+    log_info("- Variant: {pvar}")
+    plot_variant_motifs(indata, pvar, devpars, outdir)
+}