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

biopipen/scripts/scrna/AnnData2Seurat.R

@@ -1,87 +1,39 @@
-{{ biopipen_dir | joinpaths: "utils", "misc.R" | source_r }}
-
 library(rlang)
 library(Seurat)
-library(hdf5r)
-library(SeuratDisk)
+library(scplotter)
+library(biopipen.utils)
 
 adfile <- {{in.adfile | r}}
 outfile <- {{out.outfile | r}}
 dotplot_check <- {{envs.dotplot_check | r}}
 outdir <- dirname(outfile)
 assay <- {{envs.assay | r}}
-outtype <- {{envs.outtype | r}}
-
-if (outtype == "rds") {
-    h5seurat_file <- file.path(
-        outdir,
-        paste0(tools::file_path_sans_ext(basename(outfile)), ".h5seurat")
-    )
-} else if (outtype == "h5seurat") {
-    h5seurat_file <- outfile
-} else {
-    stop("Unknown output file type: ", outtype)
-}
 
-if (file.exists(h5seurat_file) && (file.mtime(h5seurat_file) < file.mtime(adfile))) {
-    file.remove(h5seurat_file)
-}
+log <- get_logger()
 
-if (!file.exists(h5seurat_file)) {
-    log_info("Converting to H5Seurat file ...")
-    Convert(adfile, dest = h5seurat_file, assay = assay, overwrite = TRUE)
-} else {
-    log_info("Using existing H5Seurat file ...")
-}
+ConvertAnnDataToSeurat(adfile, outfile = outfile, assay = assay, log = log)
 
-if (outtype == "rds") {
-    log_info("Converting to RDS file ...")
-    # Fix Missing required datasets 'levels' and 'values'
-    # https://github.com/mojaveazure/seurat-disk/issues/109#issuecomment-1722394184
-    f <- H5File$new(h5seurat_file, "r+")
-    groups <- f$ls(recursive = TRUE)
+if (!isFALSE(dotplot_check)) {
+    log$info("Reading Seurat object ...")
+    sobj <- read_obj(outfile)
 
-    for (name in groups$name[grepl("/categories$", groups$name)]) {
-        valuenames <- levelnames <- codenames <- strsplit(name, "/")[[1]]
-        valuenames[length(valuenames)] <- "values"
-        valuenames <- paste(valuenames, collapse = "/")
-        levelnames[length(levelnames)] <- "levels"
-        levelnames <- paste(levelnames, collapse = "/")
-        codenames[length(codenames)] <- "codes"
-        codenames <- paste(codenames, collapse = "/")
-        if (!f$exists(codenames)) {
-            # No codes, skip
-            next
-        }
-
-        if (!f$exists(levelnames)) {
-            f[[levelnames]] <- f[[name]]
-        }
-
-        if (!f$exists(valuenames)) {
-            f[[valuenames]] <- f[[codenames]]
-            grp <- f[[valuenames]]
-            grp$write(args = list(1:grp$dims), value = grp$read() + 1)
-        }
+    log$info("Checking dotplot ...")
+    dotfig <- file.path(outdir, "dotplot.png")
+    if (isTRUE(dotplot_check)) {
+        vobj <- FindVariableFeatures(
+            sobj, selection.method = "vst", nfeatures = 2000)
+        dotplot_check <- head(VariableFeatures(vobj), 10)
+    } else if (is.character(dotplot_check)) {
+        dotplot_check <- trimws(strsplit(dotplot_check, ",")[[1]])
     }
-    f$close_all()
-    # end
-
-    sobj <- LoadH5Seurat(h5seurat_file, assays = assay)
-    if (!isFALSE(dotplot_check)) {
-        log_info("Checking dotplot ...")
-        dotfig <- file.path(outdir, "dotplot.png")
-        if (isTRUE(dotplot_check)) {
-            vobj <- FindVariableFeatures(
-                sobj, selection.method = "vst", nfeatures = 2000)
-            dotplot_check <- head(VariableFeatures(vobj), 10)
-        } else if (is.character(dotplot_check)) {
-            dotplot_check <- trimws(strsplit(dotplot_check, ",")[[1]])
-        }
-        png(dotfig, width = 800, height = 800, res = 70)
-        p <- DotPlot(sobj, features = dotplot_check, assay = assay)
-        print(p)
-        dev.off()
-    }
-    saveRDS(sobj, outfile)
+    p <- FeatureStatPlot(
+        sobj, features = dotplot_check, plot_type = "dot",
+        assay = assay
+    )
+    res = 70
+    height <- attr(p, "height") * res
+    width <- attr(p, "width") * res
+    png(dotfig, width = width, height = height, res = res)
+    print(p)
+    dev.off()
 }

biopipen/scripts/scrna/CellCellCommunication.py

@@ -40,7 +40,7 @@ if subset_using == "auto":
     subset_using = "python" if subset and "[" in subset else "r"
 split_by = envs.pop("split_by")
 
-if sobjfile.suffix.lower() == ".rds" or sobjfile.suffix.lower() == ".h5seurat":
+if sobjfile.suffix.lower() in (".rds", ".qs", "qs2"):
     logger.info("Converting the Seurat object to h5ad ...")
 
     annfile = outfile.parent / f"{sobjfile.stem}.h5ad"

biopipen/scripts/scrna/CellCellCommunicationPlots.R

@@ -1,191 +1,74 @@
-{{ biopipen_dir | joinpaths: "utils", "misc.R" | source_r }}
 library(rlang)
 library(dplyr)
-library(ggplot2)
-library(CCPlotR)
-{{ biopipen_dir | joinpaths: "scripts", "scrna", "CCPlotR-patch.R" | source_r }}
+library(scplotter)
+library(biopipen.utils)
 
 cccfile <- {{ in.cccfile | r }}
-expfile <- {{ in.expfile | r }}
 outdir <- {{ out.outdir | r }}
 joboutdir <- {{ job.outdir | r }}
-score_col <- {{ envs.score_col | r }}
-subset <- {{ envs.subset | r }}
-cases <- {{ envs.cases | r }}
+envs <- {{ envs | r }}
+envs <- extract_vars(
+    envs,
+    "magnitude", "specificity", "devpars", "subset", "cases", "more_formats", "descr"
+)
 
 ccc <- read.table(cccfile, header=TRUE, sep="\t", check.names = FALSE)
-if (!is.null(subset)) {
-    ccc <- ccc %>% dplyr::filter(!!parse_expr(subset))
-}
-if (ncol(ccc) > 10) {
-    # from CellCellCommunication
-    if (!is.null(expfile)) {
-        log_warn("in.cccfile is from CellCellCommunication, in.expfile will be ignored")
-    }
-    if (is.null(score_col)) {
-        stop("'envs.score_col' is required for CellCellCommunication output")
-    }
-    if (!score_col %in% colnames(ccc)) {
-        stop(paste("Score column", score_col, "not found in the in.cccfile"))
-    }
-    # compose the expression data frame
-    exp <- data.frame(
-        cell_type = c(ccc$source, ccc$target),
-        gene = c(ccc$ligand, ccc$receptor),
-        mean_exp = c(ccc$ligand_trimean, ccc$receptor_trimean)
-    ) %>% distinct()
-    ccc <- ccc %>% select(
-        source, target,
-        ligand, receptor,
-        !!sym(score_col)
-    ) %>% rename(score = !!sym(score_col))
-} else {
-    if (!is.null(expfile)) {
-        exp <- read.table(expfile, header=TRUE, sep="\t", check.names = FALSE)
-    }
-}
 
-if (length(cases) == 0) {
-    stop("No cases provided.")
+if (length(ccc) == 0) {
+    stop("No data found in the input file: ", cccfile)
 }
 
-.get_default_devpars <- function(kind, nrows, ncols = NULL) {
-    if (kind == "arrow") {
-        list(
-            res = 100,
-            width = 600,
-            height = 50 + nrows * 20
-        )
-    } else if (kind == "circos") {
-        list(
-            res = 100,
-            width = 800,
-            height = 800
-        )
-    } else if (kind == "dotplot") {
-        list(
-            res = 100,
-            width = 120 + ncols * 60,
-            height = 300 + nrows * 40
-        )
-    } else if (kind == "heatmap") {
-        list(
-            res = 100,
-            width = 120 + ncols * 60,
-            height = 300 + ncols * 40
-        )
-    } else if (kind == "network") {
-        list(
-            res = 100,
-            width = 1200,
-            height = 1200
-        )
-    } else if (kind == "sigmoid") {
-        list(
-            res = 100,
-            width = max(800, ncols * 200),
-            height = 100 + nrows * 60
-        )
-    }
-}
+defaults <- list(
+    magnitude = NULL,
+    specificity = NULL,
+    subset = subset,
+    descr = descr,
+    more_formats = more_formats,
+    devpars = list(res = 100)
+)
 
-images <- lapply(names(cases), function(name) {
-    log_info("- Case: ", name, " ...")
-    case <- cases[[name]]
+cases <- expand_cases(cases, defaults)
+log <- get_logger()
+reporter <- get_reporter()
 
-    kind <- match.arg(case$kind, c("arrow", "circos", "dotplot", "heatmap", "network", "sigmoid"))
-    fun <- get(paste0("cc_", kind))
-    case$kind <- NULL
+do_case <- function(name) {
+    log$info("- Case: {name}")
+    case <- cases[[name]]
+    info <- case_info(name, outdir, is_dir = FALSE)
+    case <- extract_vars(case, "subset", "devpars", "more_formats", "descr")
 
-    gg <- NULL
-    if (kind == "arrow") {
-        cell_types <- case$cell_types
-        if (is.null(cell_types) || length(cell_types) != 2) {
-            stop("'case.cell_types' is required and must be a vector of length 2")
-        }
-        n_ligand <- length(unique(ccc[ccc$source == cell_types[1], "ligand"]))
-        n_receptor <- length(unique(ccc[ccc$target == cell_types[2], "receptor"]))
-        default_devpars <- .get_default_devpars(kind, nrows = max(n_ligand, n_receptor))
-    } else if (kind == "circos") {
-        nrows <- length(unique(c(ccc$source, ccc$target)))
-        default_devpars <- .get_default_devpars(kind, nrows = nrows)
-    } else if (kind == "dotplot" || kind == "heatmap") {
-        nrows <- length(unique(ccc$source))
-        ncols <- length(unique(ccc$target))
-        default_devpars <- .get_default_devpars(kind, nrows = nrows, ncols = ncols)
-        if (
-            (kind == "heatmap" && (is.null(case$option) || case$option != "B")) ||
-            (kind == "dotplot" && (is.null(case$option) || case$option != "B"))) {
-            gg <- theme(axis.text.x = element_text(angle = 90, hjust = 1))
-        }
-    } else if (kind == "network") {
-        nrows <- length(unique(c(ccc$source, ccc$target)))
-        ncols <- length(unique(c(ccc$ligand, ccc$receptor)))
-        default_devpars <- .get_default_devpars(kind, nrows = nrows, ncols = ncols)
-        gg <- theme(plot.margin = margin(c(50, 50, 50, 50), "pt"))
-    } else if (kind == "sigmoid") {
-        nrows <- (case$n_top_ints %||% 20) / 2  # approx
-        ncols <- length(unique(c(ccc$source, ccc$target))) / 2
-        default_devpars <- .get_default_devpars(kind, nrows = nrows, ncols = ncols)
+    case$data <- ccc
+    if (!is.null(case$subset)) {
+        case$data <- ccc %>% dplyr::filter(!!parse_expr(case$subset))
     }
-    devpars <- case$devpars %||% default_devpars
-    devpars$res <- devpars$res %||% default_devpars$res
-    devpars$width <- devpars$width %||% default_devpars$width
-    devpars$height <- devpars$height %||% default_devpars$height
-    case$devpars <- NULL
-
-    section <- case$section
-    case$section <- NULL
-
-    case$cc_df <- ccc
-    if ("exp_df" %in% names(formals(fun))) {
-        case$exp_df <- exp
+    if (is.null(case$magnitude)) {
+        case$magnitude <- NULL
+    }
+    if (is.null(case$specificity)) {
+        case$specificity <- NULL
     }
-    outpath <- file.path(outdir, paste0(slugify(name), ".png"))
-    png(outpath, width=devpars$width, height=devpars$height, res=devpars$res)
-    p <- do_call(fun, case)
-    if (!is.null(gg)) { p <- p + gg }
-    print(p)
-    dev.off()
+    p <- do_call(scplotter::CCCPlot, case)
+    save_plot(
+        p, info$prefix,
+        devpars = devpars, formats = unique(c("png", more_formats))
+    )
 
-    list(
-        section = section,
+    report <- list(
         kind = "table_image",
-        src = outpath,
-        name = name
+        src = paste0(info$prefix, ".png"),
+        download = list(),
+        descr = html_escape(descr),
+        name = html_escape(info$name)
     )
-})
-
-section_images = list()
-for (image in images) {
-    section <- image$section
-    image$section <- NULL
-    if (is.null(section)) {
-        section = "DEFAULT"
+    exformats <- setdiff(more_formats, "png")
+    if (length(exformats) > 0) {
+        report$download <- lapply(exformats, function(fmt) {
+            paste0(info$prefix, ".", fmt)
+        })
     }
-    if (!section %in% names(section_images)) {
-        section_images[[section]] = list()
-    }
-    section_images[[section]][[length(section_images[[section]]) + 1]] = image
+    reporter$add2(report, hs = c(info$section, info$name), ui = "table_of_images:2")
 }
 
-if (length(section_images) == 1 && names(section_images)[1] == "DEFAULT") {
-    add_report(
-        section_images,
-        h1 = "Cell-Cell Communication Plots",
-        ui = "table_of_images"
-    )
-} else {
-    for (section in names(section_images)) {
-        imgplots = section_images[[section]]
-        add_report(
-            list(
-                ui = "table_of_images",
-                contents = imgplots
-            ),
-            h1 = section
-        )
-    }
-}
+sapply(names(cases), do_case)
 
-save_report(joboutdir)
+reporter$save(joboutdir)