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

biopipen/scripts/scrna/SeuratPreparing.R

@@ -1,209 +1,259 @@
-source("{{biopipen_dir}}/utils/misc.R")
-
 library(Seurat)
 library(future)
 library(bracer)
-library(ggplot2)
-library(tidyseurat)
+library(dplyr)
+library(glue)
+library(biopipen.utils)
+
+metafile <- {{in.metafile | r}}
+outfile <- {{out.outfile | r}}
+joboutdir <- {{job.outdir | r}}
+envs <- {{envs | r: todot = "-", skip = 1}}
+
+if (isTRUE(envs$cache)) { envs$cache <- joboutdir }
 
-metafile = {{in.metafile | quote}}
-rdsfile = {{out.rdsfile | quote}}
-joboutdir = {{job.outdir | quote}}
-envs = {{envs | r}}
+log <- get_logger()
+reporter <- get_reporter()
 
 set.seed(8525)
-options(future.globals.maxSize = 80000 * 1024^2)
+# 8TB
+options(future.globals.maxSize = Inf)
+options(future.rng.onMisuse="ignore")
+options(Seurat.object.assay.version = "v5")
 plan(strategy = "multicore", workers = envs$ncores)
 
-metadata = read.table(
-    metafile,
-    header = TRUE,
-    row.names = NULL,
-    sep = "\t",
-    check.names = FALSE
+reporter$add(
+    list(
+        kind = "descr",
+        name = "Filters applied",
+        content = paste0(
+            "<p>Cell filters: ", html_escape(envs$cell_qc), "</p>",
+            "<p>Gene filters: </p>",
+            "<p>- Min Cells: ", envs$gene_qc$min_cells, "</p>",
+            "<p>- Excludes: ",
+            ifelse(is.null(envs$gene_qc$excludes), "Not set", paste(envs$gene_qc$excludes, collapse = ", ")),
+            "</p>"
+        )
+    ),
+    h1 = "Filters and QC"
 )
 
-meta_cols = colnames(metadata)
+metadata <- tryCatch({
+    log$debug("Trying to read Seurat object from metafile ...")
+    read_obj(metafile)
+}, error = function(e) {
+    log$debug("Failed to read Seurat object from metafile: {e$message}")
+    log$debug("Reading metafile as a table (sample info) ...")
+    read.table(
+        metafile,
+        header = TRUE,
+        row.names = NULL,
+        sep = "\t",
+        check.names = FALSE
+    )
+})
+is_seurat <- inherits(metadata, "Seurat")
+
+meta_cols <- if (is_seurat) colnames(metadata@meta.data) else colnames(metadata)
 if (!"Sample" %in% meta_cols) {
-    stop("Error: Column `Sample` is not found in metafile.")
+    stop("Error: Column `Sample` is not found in ", ifelse(is_seurat, "Seurat object's meta.data.", "metafile."))
 }
-if (!"RNAData" %in% meta_cols) {
+if (!"RNAData" %in% meta_cols && !is_seurat) {
     stop("Error: Column `RNAData` is not found in metafile.")
 }
 
+qcdir = file.path(joboutdir, "qc")
+dir.create(qcdir, showWarnings = FALSE, recursive = TRUE)
 
-rename_files = function(e, sample, path) {
-    tmpdatadir = file.path(joboutdir, "renamed", sample)
-    if (dir.exists(tmpdatadir)) {
-        unlink(tmpdatadir, recursive = TRUE)
-    }
-    dir.create(tmpdatadir, recursive = TRUE, showWarnings = FALSE)
-    barcodefile = Sys.glob(file.path(path, "*barcodes.tsv.gz"))[1]
-    file.symlink(
-        normalizePath(barcodefile),
-        file.path(tmpdatadir, "barcodes.tsv.gz")
-    )
-    genefile = glob(file.path(path, "*{genes,features}.tsv.gz"))[1]
-    file.symlink(
-        normalizePath(genefile),
-        file.path(tmpdatadir, "features.tsv.gz")
-    )
-    matrixfile = Sys.glob(file.path(path, "*matrix.mtx.gz"))[1]
-    file.symlink(
-        normalizePath(matrixfile),
-        file.path(tmpdatadir, "matrix.mtx.gz")
-    )
-    Read10X(data.dir = tmpdatadir)
-}
+sobj <- LoadSeuratAndPerformQC(
+    metadata,
+    min_cells = envs$min_cells,
+    min_features = envs$min_features,
+    cell_qc = envs$cell_qc,
+    gene_qc = envs$gene_qc,
+    tmpdir = joboutdir,
+    log = log,
+    cache = envs$cache)
 
-load_sample = function(sample) {
-    print(paste("  Loading sample:", sample, "..."))
-    mdata = as.data.frame(metadata)[metadata$Sample == sample, , drop=TRUE]
-    path = as.character(mdata$RNAData)
-    if (is.na(path) || !is.character(path) || nchar(path) == 0) {
-        warning(paste0("No path found for sample: ", sample))
-        return (NULL)
-    }
+log$info("Saving and visualizing QC results ...")
+cell_qc_df <- VizSeuratCellQC(sobj, plot_type = "table")
+write.table(cell_qc_df, file = file.path(qcdir, "cell_qc.txt"),
+            row.names = FALSE, quote = FALSE, sep = "\t")
 
-    # obj_list = list()
-    if (dir.exists(path)) {
-        exprs = tryCatch(
-            # Read10X requires
-            # - barcodes.tsv.gz
-            # - genes.tsv.gz
-            # - matrix.mtx.gz
-            # But sometimes, they are prefixed with sample name
-            # e.g.GSM4143656_SAM24345863-ln1.barcodes.tsv.gz
-            { Read10X(data.dir = path) },
-            error = function(e) rename_files(e, sample, path)
+reporter$add(
+    list(
+        name = "Cell QC metrics",
+        contents = list(
+            list(
+                kind = "descr",
+                content = paste0(
+                    "The table below show the number of cells in each sample that failed and passed the QC filters. ",
+                    "The last row shows the total number of cells that failed and passed the QC filters across all samples. "
+                )
+            ),
+            list(kind = "table", src = file.path(qcdir, "cell_qc.txt"))
         )
-    } else {
-        exprs = Read10X_h5(path)
-    }
-    if ("Gene Expression" %in% names(exprs)) {
-        exprs = exprs[["Gene Expression"]]
-    }
-    obj = CreateSeuratObject(counts=exprs, project=sample)
-    # filter the cells that don't have any gene expressions
-    cell_exprs = colSums(obj@assays$RNA)
-    obj = subset(obj, cells = names(cell_exprs[cell_exprs > 0]))
-    # obj = SCTransform(object=obj, return.only.var.genes=FALSE, verbose=FALSE)
-    obj = RenameCells(obj, add.cell.id = sample)
-    # Attach meta data
-    for (mname in names(mdata)) {
-        if (mname %in% c("RNAData", "TCRData")) { next }
-        mdt = mdata[[mname]]
-        if (is.factor(mdt)) { mdt = levels(mdt)[mdt] }
-        obj[[mname]] = mdt
-    }
-    # obj_list[[sample]] = obj
-
-    # obj_list
-    obj
-}
+    ),
+    h1 = "Filters and QC",
+    h2 = "Cell-level Quality Control",
+    ui = "tabs"
+)
 
-# Load data
-samples = as.character(metadata$Sample)
+gene_qc_df <- VizSeuratGeneQC(sobj, plot_type = "table")
+write.table(gene_qc_df, file = file.path(qcdir, "gene_qc.txt"),
+            row.names = FALSE, quote = FALSE, sep = "\t")
 
-print("- Reading samples individually ...")
-obj_list = lapply(samples, load_sample)
+reporter$add(
+    list(
+        name = "Gene QC metrics",
+        contents = list(
+            list(
+                kind = "descr",
+                content = paste0(
+                    "The table below show the number of genes in each sample that failed and passed the QC filters. ",
+                    "The last row shows the final number of genes that failed and passed the QC filters across all samples. ",
+                    "Any gene that failed the QC filters will be excluded in the merged Seurat object."
+                )
+            ),
+            list(kind = "table", src = file.path(qcdir, "gene_qc.txt")),
+            list(kind = "list", items = list(paste0(
+                "We may still end up with features slightly less than the final passed ones. ",
+                "For example, when SCTransform is used, the number of features may be less than the number of genes that passed the QC filters. ",
+                "This is because SCTransform selects the top N features based on variance. "
+            )))
+        )
+    ),
+    h1 = "Filters and QC",
+    h2 = "Gene-level Quality Control",
+    ui = "tabs"
+)
 
-print("- Merging samples ...")
-if (length(obj_list) >= 2) {
-    y = c()
-    for (i in 2:length(obj_list)) y = c(y, obj_list[[i]])
-    sobj = merge(obj_list[[1]], y)
-} else {
-    sobj = obj_list[[1]]
+for (pname in names(envs$qc_plots)) {
+    if (is.null(envs$qc_plots[[pname]])) next
+    log$info("- {pname} ...")
+    args <- envs$qc_plots[[pname]]
+    args$kind <- args$kind %||% "cell"
+    args$devpars <- args$devpars %||% list()
+    args$more_formats <- args$more_formats %||% character()
+    args$save_code <- args$save_code %||% FALSE
+    args$descr <- args$descr %||% pname
+    extract_vars(args, "kind", "devpars", "more_formats", "save_code", "descr")
+    if (kind == "gene") kind <- "gene_qc"
+    if (kind == "cell") kind <- "cell_qc"
+    args$object <- sobj
+    plot_fn <- if (kind == "cell_qc") {
+        gglogger::register(VizSeuratCellQC)
+    } else {
+        gglogger::register(VizSeuratGeneQC)
+    }
+    p <- do_call(plot_fn, args)
+    prefix <- file.path(qcdir, paste0(slugify(pname), ".", kind))
+    save_plot(p, prefix, devpars, formats = c("png", more_formats))
+    if (save_code) {
+        save_plotcode(p, prefix,
+            setup = c("library(biopipen.utils)", "load('data.RData')", "invisible(list2env(args, envir = .GlobalEnv))"),
+            "args",
+            auto_data_setup = FALSE)
+    }
+    reporter$add(
+        list(
+            name = pname,
+            contents = list(
+                list(kind = "descr", content = descr),
+                reporter$image(prefix, more_formats, save_code, kind = "image")
+            )
+        ),
+        h1 = "Filters and QC",
+        h2 = ifelse(kind == "cell_qc", "Cell-level Quality Control", "Gene-level Quality Control"),
+        ui = "tabs"
+    )
 }
 
-print("- Adding metadata for QC ...")
-sobj$percent.mt = PercentageFeatureSet(sobj, pattern = "^MT-")
-sobj$percent.ribo = PercentageFeatureSet(sobj, pattern = "^RP[SL]")
-sobj$percent.hb = PercentageFeatureSet(sobj, pattern = "^HB[^(P)]")
-sobj$percent.plat = PercentageFeatureSet(sobj, pattern = "PECAM1|PF4")
-
-dim_df = data.frame(When = "Before_QC", nCells = ncol(sobj), nGenes = nrow(sobj))
+log$info("Filtering with QC criteria ...")
+sobj <- FinishSeuratQC(sobj)
 
-if (is.null(envs$cell_qc) || length(envs$cell_qc) == 0) {
-    warning("No cell QC criteria is provided. All cells will be kept.", immediate. = TRUE)
-    envs$cell_qc = "TRUE"
-}
+sobj <- RunSeuratTransformation(
+    sobj,
+    use_sct = envs$use_sct,
+    SCTransformArgs = envs$SCTransform,
+    NormalizeDataArgs = envs$NormalizeData,
+    FindVariableFeaturesArgs = envs$FindVariableFeatures,
+    ScaleDataArgs = envs$ScaleData,
+    RunPCAArgs = envs$RunPCA,
+    log = log,
+    cache = envs$cache
+)
+sobj <- RunSeuratIntegration(
+    sobj,
+    no_integration = envs$no_integration,
+    IntegrateLayersArgs = envs$IntegrateLayers,
+    log = log,
+    cache = envs$cache
+)
 
-sobj = sobj %>% mutate(.QC = !!rlang::parse_expr(envs$cell_qc))
-feats = c("nFeature_RNA", "nCount_RNA", "percent.mt", "percent.ribo", "percent.hb", "percent.plat")
-plotsdir = file.path(joboutdir, "plots")
-dir.create(plotsdir, showWarnings = FALSE)
+# This is the last step, doesn't need to be cached
+if (!identical(envs$doublet_detector, "none")) {
+    dbldir <- file.path(joboutdir, "doublets")
+    dir.create(dbldir, showWarnings = FALSE, recursive = TRUE)
 
-# Violin plots
-print("- Plotting violin plots ...")
-for (feat in feats) {
-    print(paste0("  ", feat, "..."))
-    vln_p = VlnPlot(
+    sobj <- RunSeuratDoubletDetection(
         sobj,
-        cols = rep("white", length(samples)),
-        group.by = "Sample",
-        features = feat,
-        pt.size = 0) + NoLegend()
-    vln_p$data$.QC = sobj@meta.data$.QC
-    vln_p = vln_p + geom_jitter(
-            aes(color = .QC),
-            data = vln_p$data,
-            position = position_jitterdodge(jitter.width = 0.4, dodge.width = 0.9)
-        ) + scale_color_manual(values = c("black", "red"), breaks = c(TRUE, FALSE))
-
-    png(
-        file.path(plotsdir, paste0(feat, ".vln.png")),
-        width = 800 + length(samples) * 15, height = 600, res = 100
+        tool = envs$doublet_detector,
+        DoubletFinderArgs = envs$DoubletFinder,
+        scDblFinderArgs = envs$scDblFinder,
+        filter = FALSE,
+        log = log,
+        cache = envs$cache
     )
-    print(vln_p)
-    dev.off()
-}
 
-# Scatter plots against nCount_RNA
-print("- Plotting scatter plots ...")
-for (feat in setdiff(feats, "nCount_RNA")) {
-    print(paste0("  ", feat, "..."))
-    scat_p = FeatureScatter(
-        sobj,
-        feature1 = "nCount_RNA",
-        feature2 = feat,
-        group.by = ".QC"
-    ) +
-    NoLegend() +
-    scale_color_manual(values = c("black", "red"), breaks = c(TRUE, FALSE))
-
-    png(
-        file.path(plotsdir, paste0(feat, "-nCount_RNA.scatter.png")),
-        width = 800, height = 600, res = 100
-    )
-    print(scat_p)
-    dev.off()
-}
+    log$info("Visualizing doublet detection results ...")
+    if (identical(tolower(envs$doublet_detector), "doubletfinder")) {
+        p <- VizSeuratDoublets(sobj, plot_type = "pK", x_text_angle = 90)
+        save_plot(
+            p, file.path(dbldir, "doubletfinder_pk"),
+            devpars = list(res = 100, width = 800, height = 600),
+            formats = "png")
+        reporter$add(
+            list(
+                kind = "descr",
+                content = paste(
+                    "The pK plot from DoubletFinder to select the optimal pK value.",
+                    "See more at https://github.com/chris-mcginnis-ucsf/DoubletFinder"
+                )
+            ),
+            list(
+                kind = "image",
+                src = file.path(dbldir, "doubletfinder_pk.png")
+            ),
+            h1 = glue("Doublet detection using {envs$doublet_detector}"),
+            h2 = "BC metric vs pK"
+        )
+    }
 
-# Do the filtering
-print("- Filtering cells ...")
-sobj = sobj %>% filter(.QC)
-sobj$.QC = NULL
+    for (pt in c("dim", "pie")) {
+        p <- VizSeuratDoublets(sobj, plot_type = pt)
+        save_plot(p, file.path(dbldir, paste0("doublets_", pt)), formats = "png")
 
-print("- Filtering genes ...")
-if (is.list(envs$gene_qc)) {
-    if ("min_cells" %in% names(envs$gene_qc)) {
-        genes = rownames(sobj)[Matrix::rowSums(sobj) >= envs$gene_qc$min_cells]
-        sobj = subset(sobj, features = genes)
+        reporter$add(
+            list(
+                src = file.path(dbldir, paste0("doublets_", pt, ".png")),
+                descr = ifelse(pt == "dim", "Dimention Reduction Plot", "Pie Chart")
+            ),
+            h1 = glue("Doublet detection using {envs$doublet_detector}"),
+            h2 = "Doublets distribution",
+            ui = "table_of_images"
+        )
     }
+
+    sobj <- subset(sobj, subset = !!sym(paste0(sobj@misc$doublets$tool, "_DropletType")) != "doublet")
 }
-dim_df = rbind(
-    dim_df,
-    data.frame(
-        When = "After_Gene_QC",
-        nCells = ncol(sobj),
-        nGenes = nrow(sobj)
-    )
-)
 
-write.table(dim_df, file = file.path(plotsdir, "dim.txt"),
-            row.names = FALSE, quote = FALSE, sep = "\t")
+if (!is.null(envs$mutaters) && length(envs$mutaters) > 0) {
+    log$info("Mutating metadata ...")
+    sobj@meta.data <- sobj@meta.data %>%
+        mutate(!!!lapply(envs$mutaters, rlang::parse_expr))
+}
 
-print("- Saving results ...")
-saveRDS(sobj, rdsfile)
+log$info("Saving QC'ed seurat object ...")
+reporter$save(joboutdir)
+save_obj(sobj, outfile)

biopipen/scripts/scrna/SeuratSubClustering.R

@@ -0,0 +1,64 @@
+
+library(Seurat)
+library(future)
+library(biopipen.utils)
+
+set.seed(8525)
+
+srtfile <- {{in.srtobj | r}}
+outfile <- {{out.outfile | r}}
+ncores <- {{envs.ncores | r}}
+mutaters <- {{envs.mutaters | r}}
+subset <- {{envs.subset | r}}
+cache <- {{envs.cache | r}}
+RunPCAArgs <- {{envs.RunPCA | r: todot = "-"}}
+RunUMAPArgs <- {{envs.RunUMAP | r: todot = "-"}}
+FindNeighborsArgs <- {{envs.FindNeighbors | r: todot = "-"}}
+FindClustersArgs <- {{envs.FindClusters | r: todot = "-"}}
+cases <- {{envs.cases | r}}
+
+options(future.globals.maxSize = Inf)
+plan(strategy = "multicore", workers = ncores)
+
+log <- get_logger()
+
+cases <- expand_cases(cases, defaults = list(
+    RunPCA = RunPCAArgs,
+    RunUMAP = RunUMAPArgs,
+    FindNeighbors = FindNeighborsArgs,
+    FindClusters = FindClustersArgs,
+    subset = subset
+))
+
+if (isTRUE(cache)) {}
+
+log$info("Reading Seurat object ...")
+object <- read_obj(srtfile)
+
+if (!is.null(mutaters) && length(mutaters) > 0) {
+    log$info("Mutating meta data ...")
+    object@meta.data <- mutate(
+        object@meta.data,
+        !!!lapply(mutaters, parse_expr)
+    )
+}
+
+for (name in names(cases)) {
+    case <- cases[[name]]
+    log$info("Processing case '{name}' ...")
+
+    object <- RunSeuratSubClustering(
+        object = object,
+        subset = case$subset,
+        name = name,
+        RunPCAArgs = case$RunPCAArgs,
+        RunUMAPArgs = case$RunUMAPArgs,
+        FindNeighborsArgs = case$FindNeighborsArgs,
+        FindClustersArgs = case$FindClustersArgs,
+        log = log,
+        cache = cache
+    )
+}
+
+log$info("Saving results ...")
+biopipen.utils::save_obj(object, file = outfile)

biopipen/scripts/scrna/SeuratTo10X.R

@@ -0,0 +1,27 @@
+library(DropletUtils)
+library(Seurat)
+
+srtobjfile = {{in.srtobj | r}}
+outdir = {{out.outdir | r}}
+version = {{envs.version | r}}
+split_by = {{envs.split_by | r}}
+
+srtobj = readRDS(srtobjfile)
+if (!is.null(split_by)) {
+    # check if split_by is a valid column
+    if (is.null(srtobj[[split_by]])) {
+        stop(paste0("Column ", split_by, " not found in Seurat object"))
+    }
+
+    # split Seurat object by split_by column
+    objs <- SplitObject(srtobj, split.by = split_by)
+    for (s in names(objs)) {
+        counts <- GetAssayData(object = objs[[s]], layer = "counts")
+        odir <- file.path(outdir, s)
+        dir.create(odir, recursive = TRUE, showWarnings = FALSE)
+        write10xCounts(odir, counts, version = version, overwrite = TRUE)
+    }
+} else {
+    counts = GetAssayData(object = srtobj, layer = "counts")
+    write10xCounts(outdir, counts, version = version, overwrite = TRUE)
+}

biopipen/scripts/scrna/Slingshot.R

@@ -0,0 +1,65 @@
+library(rlang)
+library(Seurat)
+library(slingshot)
+library(biopipen.utils)
+
+sobjfile <- {{in.sobjfile | r}}
+outfile <- {{out.outfile | r}}
+group_by <- {{envs.group_by | r}}
+reduction <- {{envs.reduction | r}}
+dims <- {{envs.dims | r}}
+start <- {{envs.start | r}}
+end <- {{envs.end | r}}
+prefix <- {{envs.prefix | r}}
+reverse <- {{envs.reverse | r}}
+align_start <- {{envs.align_start | r}}
+seed <- {{envs.seed | r}}
+
+set.seed(seed)
+
+log <- get_logger()
+
+log$info("Reading Seurat object ...")
+srt <- read_obj(sobjfile)
+group_by <- group_by %||% biopipen.utils::GetIdentityColumn(srt)
+
+if (is.null(group_by) || !group_by %in% colnames(srt@meta.data)) {
+    stop(paste("Grouping column", group_by, "not found in the Seurat object"))
+}
+
+reduction <- reduction %||% DefaultDimReduc(srt)
+dims <- biopipen.utils:::.expand_number(dims)
+
+if (is.null(prefix)) {
+    prefix <- ""
+} else {
+    prefix <- paste0(prefix, "_")
+}
+
+log$info("Filtering cells in NA group_by ...")
+srt_sub <- srt[, !is.na(srt[[group_by, drop = TRUE]])]
+
+log$info("Running Slingshot ...")
+sl <- slingshot(
+    data = as.data.frame(srt_sub[[reduction]]@cell.embeddings[, dims]),
+    clusterLabels = as.character(srt_sub[[group_by, drop = TRUE]]),
+    start.clus = start, end.clus = end
+)
+
+df <- as.data.frame(slingPseudotime(sl))
+colnames(df) <- paste0(prefix, colnames(df))
+if (isTRUE(reverse)) {
+    if (isTRUE(align_start)) {
+        df <- apply(df, 2, function(x) max(x, na.rm = TRUE) - x)
+    } else {
+        df <- max(df, na.rm = TRUE) - df
+    }
+}
+
+srt <- AddMetaData(srt, metadata = df)
+srt <- AddMetaData(srt, metadata = slingBranchID(sl), col.name = paste0(prefix, "BranchID"))
+
+srt <- AddSeuratCommand(srt, "Slingshot", "slingshot(...)")
+
+log$info("Saving Seurat object ...")
+save_obj(srt, outfile)

biopipen/scripts/scrna/Subset10X.R

@@ -1,7 +1,7 @@
 library(Matrix)
 
-indir = {{in.indir | quote}}
-outdir = {{out.outdir | quote}}
+indir = {{in.indir | r}}
+outdir = {{out.outdir | r}}
 envs = {{envs | r}}
 
 set.seed(envs$seed)