biopipen 0.33.1__py3-none-any.whl → 0.34.0__py3-none-any.whl

biopipen/utils/plot.R

@@ -1,209 +0,0 @@
-library(ggplot2)
-pdf(NULL) # preventing Rplots.pdf
-
-plotVenn = function(
-    # A named list with elements,
-    # e.g. list(A=paste0("R", 1:5), B=paste0("R": 3:7))
-    data,
-    # Arguments for `ggVennDiagram()`
-    args = list(),
-    # Extra ggplot components in string
-    ggs = NULL,
-    # Parameters for device (res, width, height) for `png()`
-    devpars = list(res=100, width=800, height=600),
-    # The output file. If NULL, will return the plot object
-    outfile = NULL
-) {
-    library(ggVennDiagram)
-
-    args$x = data
-    p = do.call(ggVennDiagram, args)
-    if (!is.null(ggs)) {
-        for (gg in ggs) {
-            if (is.character(gg)) {
-                p = p + eval(parse(text=gg))
-            } else {
-                p = p + gg
-            }
-        }
-    }
-
-    if (is.null(outfile)) {
-        return (p)
-    } else {
-        for (outf in outfile) {
-            if (endsWith(outf, ".pdf")) {
-                pdf(outf, width = devpars$width / devpars$res, height=devpars$height / devpars$res)
-                print(p)
-                dev.off()
-            } else {
-                fmt = substring(outf, nchar(outf) - 2)
-                devpars$filename = outf
-                do.call(fmt, devpars)
-                print(p)
-                dev.off()
-            }
-        }
-    }
-}
-
-
-plotGG = function(
-    # A data frame (long format)
-    data,
-    # the geom
-    geom,
-    # Arguments for `geom_x()`
-    args = list(),
-    # Extra ggplot components in string
-    ggs = NULL,
-    # Parameters for device (res, width, height) for `png()`
-    devpars = list(res=100, width=1000, height=1000),
-    # The output file. If NULL, will return the plot object
-    outfile = NULL
-) {
-
-    p = ggplot(data)
-    p = p + do.call(paste0("geom_", geom), args)
-    if (!is.null(ggs)) {
-        for (gg in ggs) {
-            if (is.character(gg)) {
-                p = p + eval(parse(text=gg))
-            } else {
-                p = p + gg
-            }
-        }
-    }
-
-    if (is.null(outfile)) {
-        return (p)
-    } else {
-        for (outf in outfile) {
-            if (endsWith(outf, ".pdf")) {
-                pdf(outf, width = devpars$width / devpars$res, height=devpars$height / devpars$res)
-                print(p)
-                dev.off()
-            } else {
-                fmt = substring(outf, nchar(outf) - 2)
-                devpars$filename = outf
-                do.call(fmt, devpars)
-                print(p)
-                dev.off()
-            }
-        }
-    }
-}
-
-
-plotViolin = function(
-    # A data frame (long format)
-    data,
-    # Arguments for `geom_violin()`
-    args = list(),
-    # Extra ggplot components in string
-    ggs = NULL,
-    # Parameters for device (res, width, height) for `png()`
-    devpars = list(res=100, width=1000, height=1000),
-    # The output file. If NULL, will return the plot object
-    outfile = NULL
-) {
-    plotGG(data, "violin", args, ggs, devpars, outfile)
-}
-
-
-plotUpset = function(
-    # A named list with elements,
-    # e.g. list(A=paste0("R", 1:5), B=paste0("R": 3:7))
-    # Or a data frame
-    # https://cran.r-project.org/web/packages/ggupset/readme/README.html
-    data,
-    # Arguments for `scale_x_upset()`
-    args = list(),
-    # Extra ggplot components in string
-    ggs = "geom_bar(aes(x=V1))",
-    # Parameters for device (res, width, height) for `png()`
-    devpars = list(res=100, width=1000, height=1000),
-    # The output file. If NULL, will return the plot object
-    outfile = NULL
-) {
-    library(ggupset)
-    library(tidyr)
-    library(dplyr)
-
-    if (!is.data.frame(data) && is.list(data)) {
-        all_elems = unique(unlist(data))
-        df = data.frame(ALL_ELEMS = all_elems)
-        data = do.call(cbind, lapply(names(data), function(nd) {
-            df[df$ALL_ELEMS %in% data[[nd]], nd] = nd
-            df
-        })) %>% select(-ALL_ELEMS) %>% unite("V1", sep="; ", na.rm = TRUE) %>%
-            mutate(V1 = strsplit(V1, "; ", fixed=TRUE))
-    }
-
-    p = ggplot(data)
-    for (gg in ggs) {
-        if (is.character(gg)) {
-            p = p + eval(parse(text=gg))
-        } else {
-            p = p + gg
-        }
-    }
-    p = p + do.call(scale_x_upset, args)
-
-    if (is.null(outfile)) {
-        return (p)
-    } else {
-        for (outf in outfile) {
-            if (endsWith(outf, ".pdf")) {
-                pdf(outf, width = devpars$width / devpars$res, height=devpars$height / devpars$res)
-                print(p)
-                dev.off()
-            } else {
-                fmt = substring(outf, nchar(outf) - 2)
-                devpars$filename = outf
-                do.call(fmt, devpars)
-                print(p)
-                dev.off()
-            }
-        }
-    }
-}
-
-plotHeatmap = function(
-    # Data matrix
-	data,
-    # Arguments for `ComplexHeatmap::Heatmap()`
-    args = list(),
-    # Other arguments for `ComplexHeatmap::draw()`
-    draw = list(),
-    # Parameters for device (res, width, height) for `png()`
-    devpars = NULL,
-    # The output file. If NULL, will return the plot object
-    # If "draw", will call `ComplexHeatmap::draw()`
-    outfile = NULL
-) {
-	library(ComplexHeatmap)
-
-	args$matrix = as.matrix(data)
-	hm = do.call(Heatmap, args)
-
-    if (is.null(outfile)) {
-        return(hm)
-    } else if (identical(outfile, "draw")) {
-        do.call(ComplexHeatmap::draw, c(list(hm), draw))
-    } else {
-        for (outf in outfile) {
-            if (endsWith(outf, ".pdf")) {
-                pdf(outf, width = devpars$width / devpars$res, height=devpars$height / devpars$res)
-                do.call(ComplexHeatmap::draw, c(list(hm), draw))
-                dev.off()
-            } else {
-                fmt = substring(outf, nchar(outf) - 2)
-                devpars$filename = outf
-                do.call(fmt, devpars)
-                do.call(ComplexHeatmap::draw, c(list(hm), draw))
-                dev.off()
-            }
-        }
-    }
-}

biopipen/utils/repr.R

@@ -1,146 +0,0 @@
-library(rlang)
-
-#' The string representation of an object
-#' @param x An object
-#' @param newline Whether to add newlines to the output for each element
-#' @return The string representation
-#' @export
-repr <- function(x, newline = FALSE, ...) UseMethod("repr")
-
-repr.default <- function(x, newline = FALSE, ...) {
-    klass <- paste0(class(x), collapse = "/")
-    fallback <- paste0("<", klass, ": ", deparse(substitute(x)), ">")
-
-    tryCatch(
-        x$.repr(newline, ...),
-        error = function(e) {
-            fallback
-        }
-    )
-}
-
-repr.numeric <- function(x, newline = FALSE, ...) {
-    if (length(x) == 1) {
-        as.character(x)
-    } else if (!newline) {
-        paste0("c(", paste(x, collapse = paste0(", ")), ")")
-    } else {
-        paste0(
-            "c(\n",
-            paste0(lapply(x, function(y) paste0("  ", y)), collapse = ",\n"),
-            "\n)"
-        )
-    }
-}
-
-repr.character <- function(x, newline = FALSE, ...) {
-    if (length(x) == 1) {
-        paste0("\"", x, "\"")
-    } else if (!newline) {
-        paste0("c(", paste0(lapply(x, function(y) sQuote(y, q = FALSE)), collapse = ", "), ")")
-    } else {
-        paste0(
-            "c(\n",
-            paste0(lapply(x, function(y) paste0("  ", sQuote(y, q = FALSE))), collapse = ",\n"),
-            "\n)"
-        )
-    }
-}
-
-repr.factor <- function(x, newline = FALSE, ...) {
-    if (!newline) {
-        paste0(
-            "factor(", repr(as.character(x), newline, ...), ", levels = ", repr(levels(x), newline, ...), ")"
-        )
-    } else if (!newline) {
-        paste0(
-            "factor(\n",
-            paste0("  ", repr(as.character(x), newline, ...), ",\n"),
-            "  levels = ", repr(levels(x), newline, ...), "\n)"
-        )
-    } else {
-        paste0(
-            "factor(\n",
-            paste0("  ", repr(as.character(x), newline, ...), ",\n"),
-            "  levels = ", repr(levels(x), newline, ...), "\n)"
-        )
-    }
-}
-
-repr.logical <- function(x, newline = FALSE, ...) {
-    if (length(x) == 1) {
-        if (x) "TRUE" else "FALSE"
-    } else if (!newline) {
-        paste0("c(", paste0(x, collapse = ","), ")")
-    } else {
-        paste0(
-            "c(\n",
-            paste0(lapply(x, function(y) paste0("  ", y)), collapse = ",\n"),
-            "\n)"
-        )
-    }
-}
-
-repr.list <- function(x, newline = FALSE, ...) {
-  start <- if (newline) "list(\n" else "list("
-  end <- if (newline) "\n)" else ")"
-  sep <- if (newline) ",\n" else ", "
-  prefix <- if (newline) "  " else ""
-  if (length(names(x)) > 0) {
-    paste0(
-        start,
-        paste0(
-            lapply(seq_along(x), function(i) {
-                name <- names(x)[i]
-                if (identical(name, "")) {
-                  paste0(prefix, repr(x[[i]]))
-                } else {
-                  paste0(prefix, bQuote(name), " = ", repr(x[[name]]))
-                }
-            }), collapse = sep
-        ),
-        end
-    )
-  } else {
-    paste0(
-        start, paste0(lapply(x, repr, newline = newline, ...), collapse = sep), end
-    )
-  }
-}
-
-repr.NULL <- function(x, newline = FALSE, ...) {
-    "NULL"
-}
-
-repr.formula <- function(x, newline = FALSE, ...) {
-  deparse(x)
-}
-
-repr.data.frame <- function(x, newline = FALSE, ...) {
-  paste0(
-      "data.frame(\n",
-      paste0(
-          lapply(names(x), function(name) {
-              paste0("  ", bQuote(name), " = ", repr(x[[name]], newline = newline, ...))
-          }), collapse = ",\n"
-      ),
-      "\n)"
-  )
-}
-
-repr.environment <- function(x, newline = FALSE, ...) {
-    if (!is_environment(x)) {
-        # in case .GlobalEnv is dispatched here
-        NextMethod()
-    } else {
-        nl <- if (newline) "\n" else " "
-        prefix <- if (newline) "  " else ""
-        paste0(
-            "rlang::env(", nl, paste0(
-                lapply(ls(x), function(name) {
-                    paste0(prefix, bQuote(name), " = ", repr(get(name, x), newline = newline, ...))
-                }), collapse = paste0(",", nl)
-            ), nl, ")"
-        )
-    }
-}

biopipen/utils/rnaseq.R

@@ -1,48 +0,0 @@
-
-.normUnit = function(unit) {
-    if ("count" %in% unit) {
-        return("count")
-    }
-    return(unit)
-}
-
-glenFromGFFExons = function(exonfile) {
-    gff  = read.table(exonfile, header = F, row.names = NULL)
-    # V4: start, V5: end, V10: gene name
-    glen = aggregate(V5-V4+1 ~ V10, gff, sum)
-    genes = glen[,1]
-    glen = glen[,-1,drop=TRUE]
-    names(glen) = genes
-    return(glen)
-}
-
-count2tpm = function(x, args) {
-    if (is.null(args$genelen)) {
-        stop("Gene lengths are required to convert count to TPM.")
-    }
-    glengenes = names(args$genelen)
-    mygenes = rownames(x)
-    missing = setdiff(mygenes, glengenes)
-    warning(paste(length(missing), "gene cannot be found in gene length data"))
-    warning(paste(missing, sep=", "))
-
-    genes = intersect(mygenes, glengenes)
-    x = x[genes, , drop=FALSE]
-
-    # see: https://gist.github.com/slowkow/c6ab0348747f86e2748b
-    # and https://support.bioconductor.org/p/91218/
-    out = x / unlist(args$genelen[genes])
-    out = t(t(out) * 1e6 / colSums(out))
-    rownames(out) = genes
-    colnames(out) = colnames(x)
-
-    return(out)
-}
-
-
-unit_conversion = function(x, inunit, outunit, args=list()) {
-    inunit = .normUnit(inunit)
-    outunit = .normUnit(outunit)
-    func = get(paste0(inunit, "2", outunit))
-    func(x, args)
-}

biopipen/utils/single_cell.R

@@ -1,207 +0,0 @@
-suppressPackageStartupMessages(library(rlang))
-suppressPackageStartupMessages(library(dplyr))
-suppressPackageStartupMessages(library(tidyr))
-try(suppressPackageStartupMessages(library(immunarch)))
-
-#' Expand a Immunarch object into cell-level
-#'
-#' Here is how the data is expanded:
-#' 1. Expand `$data` by Barcode (other columns are copied)
-#' 2. Add sample to `Sample` column
-#' 3. Add columns from `$meta`
-#'
-#' @param immdata Immunarch object
-#' @return A data frame
-#'
-#' @example
-#' immunarch::immdata$data$MS1 |> head()
-#' #   Clones Proportion CDR3.nt            CDR3.aa V.name D.name J.name V.end D.start D.end J.start VJ.ins VD.ins DJ.ins Sequence
-#' #    <dbl>      <dbl> <chr>              <chr>   <chr>  <chr>  <chr>  <int>   <int> <int>   <int>  <dbl>  <dbl>  <dbl> <lgl>
-#' # 1    539    0.0634  TGTGCCAGCAGCTTACA… CASSLQ… TRBV7… TRBD2  TRBJ2…    14      18    26      29     -1      3      2 NA
-#' # 2    320    0.0376  TGTGCCAGCAGCGTGTA… CASSVY… TRBV9  TRBD1  TRBJ2…    13      20    22      29     -1      6      6 NA
-#' immunarch::immdata$meta |> head()
-#' #   Sample  ID    Sex     Age Status Lane
-#' #   <chr>   <chr> <chr> <dbl> <chr>  <chr>
-#' # 1 A2-i129 C1    M        11 C      A
-#' # 2 A2-i131 C2    M         9 C      A
-#' # 3 A2-i133 C4    M        16 C      A
-#' # 4 A2-i132 C3    F         6 C      A
-#' # 5 A4-i191 C8    F        22 C      B
-#' # 6 A4-i192 C9    F        24 C      B
-#'
-#' @export
-expand_immdata <- function(immdata, cell_id = "Barcode") {
-    if (!cell_id %in% colnames(immdata$data[[1]])) {
-        stop(paste0("cell_id '", cell_id, "' not found in data"))
-    }
-    do.call(rbind, lapply(names(immdata$data), function(name) {
-        # Split barcodes
-        dat <- immdata$data[[name]] %>% separate_rows(!!sym(cell_id), sep = ";")
-        dat$Sample <- name
-        dat <- dat %>% left_join(immdata$meta, by = "Sample", suffix = c("_data", ""))
-
-        dat
-    }))
-}
-
-#' Filter expanded immdata
-#'
-#' @param exdata Expanded immdata
-#' @param filters Filters
-#' @return Filtered data
-#'
-#' @export
-filter_expanded_immdata <- function(exdata, filters, update_clones = FALSE) {
-    if (length(filters) == 0) {
-        return(exdata)
-    }
-    out <- exdata %>% dplyr::filter(!!parse_expr(filters))
-    if (update_clones) {
-        out <- out %>%
-            group_by(Sample, CDR3.aa) %>%
-            mutate(Clones = n()) %>%
-            ungroup() %>%
-            group_by(Sample) %>%
-            mutate(Proportion = Clones / n()) %>%
-            ungroup() %>%
-            arrange(Sample, desc(Clones))
-    }
-    out
-}
-
-#' Convert expanded immdata to Immunarch object
-#'
-#' @param exdata Expanded immdata
-#' @param metacols Columns to be added to `$meta`
-#' @return Immunarch object
-#'
-#' @export
-immdata_from_expanded <- function(
-    exdata,
-    metacols = NULL,
-    cell_id = "Barcode",
-    update_clones = TRUE
-) {
-    if (is.null(metacols)) {
-        metacols = setdiff(colnames(exdata), c(
-            "Clones", "Proportion", "CDR3.nt", "CDR3.aa", "V.name", "D.name", "J.name",
-            "V.end", "D.start", "D.end", "J.start", "VJ.ins", "VD.ins", "DJ.ins",
-            "Sequence", "chain", "Barcode", "raw_clonotype_id", "ContigID", "C.name",
-            "CDR1.nt", "CDR2.nt", "CDR1.aa", "CDR2.aa", "FR1.nt", "FR2.nt", "FR3.nt",
-            "FR4.nt", "FR1.aa", "FR2.aa", "FR3.aa", "FR4.aa"
-        ))
-    }
-    out <- list(meta = exdata[, metacols, drop = FALSE])
-    out$meta <- out$meta[!duplicated(out$meta$Sample), , drop = FALSE]
-    out$data <- lapply(
-        split(
-            exdata[, setdiff(colnames(exdata), metacols), drop = FALSE],
-            exdata$Sample
-        ),
-        function(dat) {
-            ncells <- nrow(dat)
-            dat_cols <- setdiff(colnames(dat), c("Clones", "Proportion", cell_id))
-            dat %>% group_by(CDR3.aa) %>%
-                summarise(
-                    Clones = ifelse(update_clones, n(), first(Clones)),
-                    Proportion = ifelse(update_clones, n() / ncells, first(Proportion)),
-                    !!sym(cell_id) := paste0(!!sym(cell_id), collapse = ";"),
-                    !!!parse_exprs(sapply(dat_cols, function(x) paste0('first(`', x, '`)'))),
-                    .groups = "drop"
-                ) %>%
-                arrange(desc(Clones))
-        }
-    )
-    out
-}
-
-#' Convert Seurat object to Anndata
-#'
-#' @param sobjfile Seurat object file
-#' @param outfile Output file
-#' @param assay Assay to be used
-#'
-#' @export
-seurat_to_anndata <- function(sobjfile, outfile, assay = NULL, log_info, tmpdir = NULL, log_indent = "") {
-    library(Seurat)
-    library(SeuratDisk)
-    library(hdf5r)
-    if (endsWith(sobjfile, ".rds") || endsWith(sobjfile, ".RDS")) {
-        library(digest)
-
-        dig <- digest::digest(sobjfile, algo = "md5")
-        dig <- substr(dig, 1, 8)
-        assay_name <- ifelse(is.null(assay), "", paste0("_", assay))
-        tmpdir <- tmpdir %||% dirname(outfile)
-        dir.create(tmpdir, showWarnings = FALSE)
-        h5seurat_file <- file.path(
-            tmpdir,
-            paste0(
-                tools::file_path_sans_ext(basename(outfile)),
-                assay_name, ".", dig, ".h5seurat"
-            )
-        )
-        if (file.exists(h5seurat_file) &&
-            (file.mtime(h5seurat_file) < file.mtime(sobjfile))) {
-            file.remove(h5seurat_file)
-        }
-        if (!file.exists(h5seurat_file)) {
-            log_info("{log_indent}Reading RDS file ...")
-            sobj <- readRDS(sobjfile)
-            assay <- assay %||% DefaultAssay(sobj)
-            # In order to convert to h5ad
-            # https://github.com/satijalab/seurat/issues/8220#issuecomment-1871874649
-            sobj$RNAv3 <- as(object = sobj[[assay]], Class = "Assay")
-            DefaultAssay(sobj) <- "RNAv3"
-            sobj$RNA <- NULL
-            sobj <- RenameAssays(sobj, RNAv3 = "RNA")
-
-            log_info("{log_indent}Saving to H5Seurat file ...")
-            SaveH5Seurat(sobj, h5seurat_file)
-            rm(sobj)
-            gc()
-            sobjfile <- h5seurat_file
-        } else {
-            log_info("{log_indent}Using existing H5Seurat file ...")
-        }
-    }
-
-    if (!endsWith(sobjfile, ".h5seurat")) {
-        stop(paste0("Unknown input file format: ",
-            tools::file_ext(sobjfile),
-            ". Supported formats: .rds, .RDS, .h5seurat"))
-    }
-
-    log_info("{log_indent}Converting to Anndata ...")
-    Convert(sobjfile, dest = outfile, assay = assay %||% "RNA", overwrite = TRUE)
-
-    log_info("{log_indent}Fixing categorical data ...")
-    # See: https://github.com/mojaveazure/seurat-disk/issues/183
-    H5.create_reference <- function(self, ...) {
-        space <- self$get_space()
-        do.call("[", c(list(space), list(...)))
-        ref_type <- hdf5r::h5const$H5R_OBJECT
-        ref_obj <- hdf5r::H5R_OBJECT$new(1, self)
-        res <- .Call("R_H5Rcreate", ref_obj$ref, self$id, ".", ref_type,
-                    space$id, FALSE, PACKAGE = "hdf5r")
-        if (res$return_val < 0) {
-            stop("Error creating object reference")
-        }
-        ref_obj$ref <- res$ref
-        return(ref_obj)
-    }
-
-    h5ad <- H5File$new(outfile, "r+")
-    cats <- names(h5ad[["obs/__categories"]])
-    for (cat in cats) {
-        catname <- paste0("obs/__categories/", cat)
-        obsname <- paste0("obs/", cat)
-        ref <- H5.create_reference(h5ad[[catname]])
-        h5ad[[obsname]]$create_attr(
-            attr_name = "categories",
-            robj = ref,
-            space = H5S$new(type = "scalar")
-        )
-    }
-    h5ad$close()
-}