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

biopipen/scripts/scrna/CCPlotR-patch.R

@@ -0,0 +1,161 @@
+# patched version of cc_circos
+# See https://github.com/Sarah145/CCPlotR/issues/4
+
+cc_circos <- function(cc_df, option = "A", n_top_ints = 15, exp_df = NULL, cell_cols = NULL, palette = "BuPu", cex = 1, show_legend = TRUE, scale = FALSE, ...) {
+    stopifnot("'cc_df' must be a dataframe" = is(cc_df, "data.frame"))
+    stopifnot("cc_df should contain columns named source, target, ligand, receptor and score. See `toy_data` for an example." = all(c('source', 'target', 'ligand', 'receptor', 'score') %in% colnames(cc_df)))
+    stopifnot("option must be either 'A', 'B', 'C'" = option %in% c('A', 'B', 'C'))
+    library(stringr)
+    library(ComplexHeatmap)
+    library(circlize)
+    circos.clear()
+
+    target <- score <- ligand <- receptor <- source_lig <- target_rec <- cell_type <- gene <- cell_gene <- NULL
+    if (option == "A") {
+        input_df <- cc_df %>%
+            mutate(source = factor(source), target = factor(target)) %>%
+            group_by(source, target) %>%
+            tally()
+        if (is.null(cell_cols)) {
+            cell_cols <- setNames(paletteMartin(n = length(unique(c(input_df$source, input_df$target)))), unique(c(input_df$source, input_df$target)))
+        }
+        circlize_plot <- function() {
+            par(cex = cex)
+            chordDiagram(input_df,
+                scale = FALSE, grid.col = cell_cols,
+                annotationTrack = c("grid", "name"), directional = 1, direction.type = c("arrows", "diffHeight"), link.arr.type = "big.arrow", link.arr.length = 0.1, diffHeight = -mm_h(0.5), preAllocateTracks = list(
+                    track.height = mm_h(10),
+                    track.margin = c(mm_h(2), -mm_h(4))
+                ), ...
+            )
+        }
+    } else if (option == "B") {
+        input_df <- cc_df %>%
+            slice_max(order_by = score, n = n_top_ints) %>%
+            mutate(
+                source_lig = paste0(source, "|", ligand),
+                target_rec = paste0(target, "|", receptor)
+            )
+        arr_wd <- (((input_df$score - min(input_df$score)) / (max(input_df$score) - min(input_df$score))) * (4)) + 1
+
+        if (is.null(cell_cols)) {
+            cell_cols <- setNames(paletteMartin(n = length(unique(c(input_df$source, input_df$target)))), unique(c(input_df$source, input_df$target)))
+        }
+
+        link_cols <- c()
+        for (i in input_df$source_lig) {
+            link_cols <- c(link_cols, cell_cols[str_extract(i, "[^|]+")])
+        }
+
+        segments <- unique(c(paste0(input_df$source, "|", input_df$ligand), paste0(input_df$target, "|", input_df$receptor)))
+        grp <- str_extract(segments, "[^|]+")
+        names(grp) <- segments
+        lgd <- Legend(
+            labels = unique(c(input_df$source, input_df$target)),
+            title = "Cell type",
+            type = "points",
+            title_gp = gpar(fontsize = 14 * cex),
+            labels_gp = gpar(fontsize = 12 * cex),
+            legend_gp = gpar(col = "transparent"),
+            background = cell_cols[unique(c(input_df$source, input_df$target))]
+        )
+        circlize_plot <- function() {
+            par(cex = cex)
+            chordDiagram(
+                input_df %>%
+                    select(source_lig, target_rec, score),
+                directional = 1, group = grp, link.sort = FALSE, scale = scale, diffHeight = 0.005,
+                direction.type = c("arrows"), link.arr.type = "triangle", annotationTrack = c(),
+                preAllocateTracks = list(list(track.height = 0.175), list(track.height = 0.05)),
+                big.gap = 3, transparency = 1, link.arr.lwd = arr_wd, link.arr.col = link_cols,
+                link.arr.length = 0.4, link.arr.width = 0.35, ...
+            )
+            circos.track(track.index = 1, panel.fun = function(x, y) {
+                circos.text(CELL_META$xcenter, CELL_META$ylim[1], str_extract(CELL_META$sector.index, "[^|]+$"),
+                    facing = "clockwise", niceFacing = TRUE, adj = c(0, 0.55), cex = 1.3
+                )
+            }, bg.border = NA)
+            for (l in unique(str_extract(segments, "[^|]+"))) {
+                highlight.sector(segments[str_detect(segments, paste0("^", str_escape(l)))], track.index = 2, col = cell_cols[l])
+            }
+            if (show_legend == TRUE) {
+                draw(lgd, just = c("left", "bottom"), x = unit(5, "mm"), y = unit(5, "mm"))
+            }
+            circos.clear()
+        }
+    } else if (option == "C") {
+        stopifnot("'exp_df' must be a dataframe" = is(exp_df, "data.frame"))
+        stopifnot("exp_df should contain columns named cell_type, gene and mean_exp. See `toy_exp` for an example." = all(c('cell_type', 'gene', 'mean_exp') %in% colnames(exp_df)))
+
+        input_df <- cc_df %>%
+            slice_max(order_by = score, n = n_top_ints) %>%
+            mutate(
+                source_lig = paste0(source, "|", ligand),
+                target_rec = paste0(target, "|", receptor)
+            )
+
+        arr_wd <- (((input_df$score - min(input_df$score)) / (max(input_df$score) - min(input_df$score))) * (4)) + 1
+
+        if (is.null(cell_cols)) {
+            cell_cols <- setNames(paletteMartin(n = length(unique(c(input_df$source, input_df$target)))), unique(c(input_df$source, input_df$target)))
+        }
+
+        segments <- unique(c(paste0(input_df$source, "|", input_df$ligand), paste0(input_df$target, "|", input_df$receptor)))
+        grp <- str_extract(segments, "[^|]+")
+        names(grp) <- segments
+
+        gene_df <- as.data.frame(exp_df %>% mutate(cell_gene = paste0(cell_type, "|", gene)) %>% filter(cell_gene %in% segments))
+        rownames(gene_df) <- gene_df$cell_gene
+
+        brks <- scales::pretty_breaks(n = 5)(c(floor(min(gene_df$mean_exp)), ceiling(max(gene_df$mean_exp))))
+        gene_col_fun <- colorRamp2(brks, RColorBrewer::brewer.pal(length(brks), palette))
+
+        inner.cols <- setNames(gene_col_fun(gene_df[segments, "mean_exp"]), segments)
+        lgd1 <- Legend(
+            labels = unique(c(input_df$source, input_df$target)),
+            title = "Cell type",
+            type = "points",
+            title_gp = gpar(fontsize = 14 * cex),
+            labels_gp = gpar(fontsize = 12 * cex),
+            legend_gp = gpar(col = "transparent"),
+            background = cell_cols[unique(c(input_df$source, input_df$target))],
+            direction = "horizontal"
+        )
+
+        lgd2 <- Legend(
+            title_gp = gpar(fontsize = 14 * cex),
+            labels_gp = gpar(fontsize = 12 * cex),
+            direction = "horizontal", at = brks,
+            col_fun = gene_col_fun, title = "Mean exp."
+        )
+        circlize_plot <- function() {
+            par(cex = cex)
+            chordDiagram(
+                input_df %>%
+                    select(source_lig, target_rec, score),
+                directional = 1, group = grp, link.sort = FALSE, diffHeight = 0.005, scale = scale,
+                direction.type = c("arrows"), link.arr.type = "triangle", annotationTrack = c(),
+                preAllocateTracks = list(list(track.height = 0.175), list(track.height = 0.05), list(track.height = 0.045)),
+                big.gap = 3, transparency = 1, link.arr.lwd = arr_wd, link.arr.col = "black", link.arr.length = 0.4, link.arr.width = 0.35, ...
+            )
+            circos.track(track.index = 1, panel.fun = function(x, y) {
+                circos.text(CELL_META$xcenter, CELL_META$ylim[1], str_extract(CELL_META$sector.index, "[^|]+$"),
+                    facing = "clockwise", niceFacing = TRUE, adj = c(0, 0.55), cex = 1.3
+                )
+            }, bg.border = NA)
+            for (l in unique(str_extract(segments, "[^|]+"))) {
+                highlight.sector(segments[str_detect(segments, paste0("^", str_escape(l)))], track.index = 2, col = cell_cols[l])
+            }
+            circos.track(track.index = 3, panel.fun = function(x, y) {
+                circos.rect(CELL_META$xlim[1], CELL_META$ylim[1], CELL_META$xlim[2], CELL_META$ylim[2],
+                    sector.index = CELL_META$sector.index, col = inner.cols[CELL_META$sector.index]
+                )
+            }, bg.border = NA)
+            if (show_legend == TRUE) {
+                draw(packLegend(lgd1, lgd2, direction = "vertical"), just = c("left", "bottom"), x = unit(4.75, "mm"), y = unit(4.75, "mm"))
+            }
+            circos.clear()
+        }
+    }
+    circlize_plot()
+}

biopipen/scripts/scrna/CellCellCommunication.py

@@ -0,0 +1,150 @@
+from pathlib import Path
+from biopipen.utils.misc import run_command, logger
+from biopipen.scripts.scrna.seurat_anndata_conversion import convert_seurat_to_anndata
+import os
+import numpy as np
+import pandas as pd
+import scanpy
+import liana
+import liana.method.sc._liana_pipe as _liana_pipe
+
+# AttributeError: module 'numpy' has no attribute 'product'
+if not hasattr(np, "product"):
+    np.product = np.prod
+
+# monkey-patch liana.method.sc._liana_pipe._trimean due to the updates by scipy 1.14
+# https://github.com/scipy/scipy/commit/a660202652deead0f3b4b688eb9fdcdf9f74066c
+def _trimean(a, axis=0):
+    try:
+        arr = a.A
+    except AttributeError:
+        arr = a.toarray()
+
+    quantiles = np.quantile(arr, q=[0.25, 0.75], axis=axis)
+    median = np.median(arr, axis=axis)
+    return (quantiles[0] + 2 * median + quantiles[1]) / 4
+
+
+_liana_pipe._trimean = _trimean
+
+
+sobjfile = Path({{in.sobjfile | quote}})  # pyright: ignore  # noqa: E999
+outfile = Path({{out.outfile | quote}})  # pyright: ignore
+envs: dict = {{envs | dict}}  # pyright: ignore
+
+# https://github.com/h5py/h5py/issues/1082#issuecomment-1311498466
+os.environ["HDF5_USE_FILE_LOCKING"] = "FALSE"
+method = envs.pop("method")
+assay = envs.pop("assay")
+ncores = envs.pop("ncores")
+species = envs.pop("species")
+rscript = envs.pop("rscript")
+subset = envs.pop("subset")
+group_by = envs.pop("group_by", None)
+groupby = envs.pop("groupby", None) or group_by
+subset_using = envs.pop("subset_using", "auto")
+if subset_using == "auto":
+    subset_using = "python" if subset and "[" in subset else "r"
+split_by = envs.pop("split_by")
+
+if sobjfile.suffix.lower() in (".rds", ".qs", "qs2"):
+    annfile = outfile.parent / f"{sobjfile.stem}.h5ad"
+    seurat_ident_col = convert_seurat_to_anndata(
+        input_file=str(sobjfile),
+        output_file=str(annfile),
+        assay=assay,
+        subset=subset if subset_using == "r" else None,
+        rscript=rscript,
+        return_ident_col=not groupby,
+    )
+    groupby = groupby or seurat_ident_col
+    sobjfile = annfile
+elif subset and subset == "r":
+    raise ValueError(
+        "h5ad file is provided as input, ",
+        "'subset' can only be a 'python' expression (`envs.subset_using = 'python'`)."
+    )
+
+if not groupby:
+    logger.warning(
+        "`groupby` is not provided. "
+        "Using 'seurat_clusters' as the default groupby column. "
+        "It is recommended to provide the `groupby` parameter."
+    )
+    groupby = "seurat_clusters"
+
+envs["groupby"] = groupby
+
+logger.info("Reading the h5ad file ...")
+adata = scanpy.read_h5ad(sobjfile)
+
+if subset and subset_using == "python":
+    logger.info("Subsetting the data ...")
+    adata = adata[{{envs['subset']}}]  # pyright: ignore
+
+method = method.lower()
+if method == "log2fc":
+    method_fun = liana.mt.logfc
+else:
+    method_fun = getattr(liana.mt, method)
+
+envs["resource_name"] = "consensus" if species == "human" else "mouseconsensus"
+envs["n_jobs"] = ncores
+envs["inplace"] = True
+envs["verbose"] = True
+envs["key_added"] = "liana_ccc"
+
+if split_by:
+    split_vals = adata.obs[split_by].unique()
+    result: pd.DataFrame = None  # type: ignore
+    for split_val in split_vals:
+        logger.info(f"Running {method} for {split_by} = {split_val} ...")
+        adata_split = adata[adata.obs[split_by] == split_val]
+        envs["adata"] = adata_split
+
+        method_fun(**envs)
+        res = adata_split.uns['liana_ccc']
+        res[split_by] = split_val
+
+        if result is None:
+            result = res
+        else:
+            result = pd.concat([result, res], ignore_index=True)
+else:
+    logger.info(f"Running {method} ...")
+    envs["adata"] = adata
+    method_fun(**envs)
+
+    result = adata.uns['liana_ccc']
+
+mag_score_names = {
+    "cellphonedb": "lr_means",
+    "connectome": "expr_prod",
+    "log2fc": None,
+    "natmi": "expr_prod",
+    "singlecellsignalr": "lrscore",
+    "rank_aggregation": "magnitude_rank",
+    "geometric_mean": "lr_gmeans",
+    "scseqcomm": "inter_score",
+    "cellchat": "lr_probs",
+}
+
+spec_score_names = {
+    "cellphonedb": "cellphone_pvals",
+    "connectome": "scaled_weight",
+    "log2fc": "lr_logfc",
+    "natmi": "spec_weight",
+    "singlecellsignalr": None,
+    "rank_aggregation": "specificity_rank",
+    "geometric_mean": "gmean_pvals",
+    "scseqcomm": None,
+    "cellchat": "cellchat_pvals",
+}
+
+if mag_score_names[method] is not None:
+    result['mag_score'] = result[mag_score_names[method]]
+if spec_score_names[method] is not None:
+    result['spec_score'] = result[spec_score_names[method]]
+
+logger.info("Saving the result ...")
+result.to_csv(outfile, sep="\t", index=False)

biopipen/scripts/scrna/CellCellCommunicationPlots.R

@@ -0,0 +1,93 @@
+library(rlang)
+library(dplyr)
+library(scplotter)
+library(biopipen.utils)
+
+cccfile <- {{ in.cccfile | r }}
+outdir <- {{ out.outdir | r }}
+joboutdir <- {{ job.outdir | 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 (length(ccc) == 0) {
+    stop("No data found in the input file: ", cccfile)
+}
+
+defaults <- list(
+    magnitude = NULL,
+    specificity = NULL,
+    subset = subset,
+    descr = descr,
+    more_formats = more_formats,
+    devpars = list(res = 100)
+)
+
+cases <- expand_cases(cases, defaults, default_case = "Cell-Cell Communication")
+log <- get_logger()
+reporter <- get_reporter()
+
+do_case <- function(name) {
+    log$info("- Case: {name}")
+    case <- cases[[name]]
+    info <- case_info(name, outdir, is_dir = FALSE)
+    case <- extract_vars(case, subset_ = "subset", "devpars", "more_formats", "descr")
+
+    case$data <- ccc
+    if (!is.null(subset_)) {
+        case$data <- ccc %>% dplyr::filter(!!parse_expr(subset_))
+    }
+
+    if (identical(case$plot_type, "table")) {
+        write.table(
+            case$data,
+            file = paste0(info$prefix, ".txt"),
+            sep = "\t",
+            row.names = FALSE,
+            col.names = TRUE,
+            quote = FALSE
+        )
+        report <- list(
+            kind = "table",
+            data = list(nrows = 100),
+            src = paste0(info$prefix, ".txt")
+        )
+        reporter$add2(report, hs = c(info$section, info$name))
+        return()
+    }
+
+    if (is.null(case$magnitude)) {
+        case$magnitude <- NULL
+    }
+    if (is.null(case$specificity)) {
+        case$specificity <- NULL
+    }
+    p <- do_call(scplotter::CCCPlot, case)
+    save_plot(
+        p, info$prefix,
+        devpars = devpars, formats = unique(c("png", more_formats))
+    )
+
+    report <- list(
+        kind = "table_image",
+        src = paste0(info$prefix, ".png"),
+        download = list(),
+        descr = html_escape(descr),
+        name = html_escape(info$name)
+    )
+    exformats <- setdiff(more_formats, "png")
+    if (length(exformats) > 0) {
+        report$download <- lapply(exformats, function(fmt) {
+            paste0(info$prefix, ".", fmt)
+        })
+    }
+    reporter$add2(report, hs = c(info$section, info$name), ui = "table_of_images:2")
+}
+
+sapply(names(cases), do_case)
+
+reporter$save(joboutdir)

biopipen/scripts/scrna/CellSNPLite.py

@@ -0,0 +1,30 @@
+from __future__ import annotations
+
+from contextlib import suppress
+from pathlib import Path
+from biopipen.core.filters import dict_to_cli_args
+from biopipen.utils.misc import run_command
+
+crdir = Path({{in.crdir | quote}})  # noqa: E999 # pyright: ignore
+outdir = {{out.outdir | quote}}  # pyright: ignore
+envs: dict = {{envs | repr}}  # pyright: ignore
+cellsnp_lite = envs.pop("cellsnp_lite")
+ncores = envs.pop("ncores")
+
+with suppress(RuntimeError):
+    run_command([cellsnp_lite, "--version"], fg=True)
+    print("")
+
+if crdir.name != "outs":
+    crdir = crdir / "outs"
+
+bamfile = str(crdir / "possorted_genome_bam.bam")
+barcodefile = str(crdir / "filtered_feature_bc_matrix" / "barcodes.tsv.gz")
+
+envs["nproc"] = ncores
+envs["samFile"] = bamfile
+envs["barcodeFile"] = barcodefile
+envs["outDir"] = outdir
+
+cmd = [cellsnp_lite, *dict_to_cli_args(envs)]
+run_command(cmd, fg=True, bufsize=1)

biopipen/scripts/scrna/CellTypeAnnotation-celltypist.R

@@ -0,0 +1,185 @@
+library(rlang)
+library(hdf5r)
+library(dplyr)
+library(Seurat)
+library(biopipen.utils)
+
+sobjfile <- {{in.sobjfile | r}}
+outfile <- {{out.outfile | r}}
+newcol <- {{envs.newcol | r}}
+cluster_ident <- {{envs.ident | r }}
+merge_same_labels <- {{envs.merge | r}}
+celltypist_args <- {{envs.celltypist_args | r}}
+outtype <- {{envs.outtype | r }}
+if (identical(outtype, "input")) {
+    outtype <- tolower(tools::file_ext(outfile))  # rds, h5ad, qs/qs2
+}
+
+outdir <- dirname(outfile)
+outprefix <- file.path(outdir, tools::file_path_sans_ext(basename(outfile)))
+
+over_clustering <- celltypist_args$over_clustering %||% cluster_ident
+
+require_package("celltypist", version = ">=1.7.1", python = celltypist_args$python)
+
+log <- get_logger()
+
+if (is.null(celltypist_args$model)) {
+    stop("Please specify a model for celltypist (envs.celltypist_args.model)")
+} else if (!file.exists(celltypist_args$model)) {
+    stop(paste0("Model file not found (envs.celltypist_args.model)"))
+}
+dir.create(file.path(outdir, "data", "models"), recursive = TRUE, showWarnings = FALSE)
+modelfile <- file.path(outdir, "data", "models", basename(celltypist_args$model))
+suppressWarnings(file.remove(modelfile))
+file.symlink(normalizePath(celltypist_args$model), modelfile)
+
+sobj <- NULL
+ident <- NULL
+if (!endsWith(sobjfile, ".h5ad")) {
+    sobj <- read_obj(sobjfile)
+    ident <- GetIdentityColumn(sobj)
+    over_clustering <- over_clustering %||% ident
+
+    if (!isFALSE(over_clustering)) {
+        destfile <- paste0(outprefix, ".", over_clustering, ".h5ad")
+    } else {
+        destfile <- paste0(outprefix, ".h5ad")
+    }
+
+    if (file.exists(destfile) && (file.mtime(destfile) < file.mtime(sobjfile))) {
+        file.remove(destfile)
+    }
+    if (file.exists(destfile)) {
+        log$warn("Using existing H5AD file: {destfile} ...")
+    } else {
+        log$info("Converting to H5AD file ...")
+        ConvertSeuratToAnnData(
+            sobj,
+            outfile = destfile,
+            assay = celltypist_args$assay,
+            log = log
+        )
+    }
+    sobjfile <- destfile
+}
+
+# sobjfile h5ad ensured
+# use celltypist to annotate
+log$info("Annotating cell types using celltypist ...")
+# celltypist_script <- file.path(
+#     "{ {biopipen_dir} }", "scripts", "scrna", "celltypist-wrapper.py"
+# )
+# In case this script is running in the cloud and <biopipen_dir> can not be found in there
+# In stead, we use the python command, which is associated with the cloud environment,
+# to get the biopipen directory
+biopipen_dir <- get_biopipen_dir(celltypist_args$python)
+celltypist_script <- file.path(
+    biopipen_dir, "scripts", "scrna", "celltypist-wrapper.py"
+)
+
+if (outtype == "h5ad") {
+    celltypist_outfile <- outfile
+} else if (outtype == "rds" || outtype == "qs" || outtype == "qs2") {
+    ext <- if (is.null(sobj)) ".h5ad" else ".txt"
+    celltypist_outfile <- paste0(outprefix, ".celltypist", ext)
+} else {
+    stop(paste0("Unknown output type: ", outtype))
+}
+
+if (file.exists(celltypist_outfile) &&
+    (file.mtime(celltypist_outfile) > file.mtime(sobjfile))) {
+    log$warn("Using existing celltypist results: {celltypist_outfile} ...")
+} else {
+    command <- paste(
+        paste0("CELLTYPIST_FOLDER='", outdir, "'"),
+        celltypist_args$python,
+        celltypist_script,
+        "-i", sobjfile,
+        "-m", celltypist_args$model,
+        "-o", celltypist_outfile
+    )
+    if (!isFALSE(over_clustering) && !is.null(over_clustering)) {
+        command <- paste(command, "-c", over_clustering)
+    }
+    if (isTRUE(celltypist_args$majority_voting)) {
+        command <- paste(command, "-v")
+    }
+    log$info("Running celltypist:")
+    # print("- {command}")
+    log$debug("  {command}")
+    rc <- system(command)
+    if (rc != 0) {
+        stop("Failed to run celltypist. Check the job.stderr file to see the error message.")
+    }
+}
+
+if (outtype == "h5ad") {
+    if (merge_same_labels) {
+        log$warn("- Merging clusters with the same labels is not supported and is ignored for h5ad outfile ...")
+    }
+} else if (outtype == "rds" || outtype == "qs" || outtype == "qs2") {
+    if (is.null(sobj)) {
+        log$info("Reading H5AD from celltypist ...")
+        sobj <- ConvertAnnDataToSeurat(
+            infile = celltypist_outfile,
+            outfile = NULL,
+            assay = celltypist_args$assay %||% "RNA",
+            ident = ident,
+            log = log
+        )
+    } else {
+        log$info("Attaching celltypist results to Seurat object ...")
+
+        celltypist_out <- read.table(
+            celltypist_outfile, sep = "\t", header = TRUE, row.names = 1)
+
+        sobj <- AddMetaData(
+            sobj,
+            celltypist_out[
+                rownames(sobj@meta.data),
+                setdiff(colnames(celltypist_out), colnames(sobj@meta.data)),
+                drop = FALSE
+            ]
+        )
+    }
+
+    if (celltypist_args$majority_voting) {
+        prediction <- "majority_voting"
+
+        if (!is.null(newcol)) {
+            sobj@meta.data[[newcol]] <- sobj@meta.data[[prediction]]
+        } else if (!isFALSE(over_clustering) && !is.null(over_clustering)) {
+            # save the original over_clustering column as seurat_clusters_id
+            sobj@meta.data$seurat_clusters_id <- sobj@meta.data[[over_clustering]]
+
+            # make a map of original cluster id to new cluster id
+            cluster_map <- data.frame(
+                seurat_clusters_id = sobj@meta.data$seurat_clusters_id,
+                seurat_clusters = sobj@meta.data[[prediction]]
+                ) %>%
+                group_by(seurat_clusters_id) %>%
+                summarise(seurat_clusters = first(seurat_clusters), .groups = "drop") %>%
+                mutate(seurat_clusters = make.unique(seurat_clusters))
+            cluster_map <- split(cluster_map$seurat_clusters, cluster_map$seurat_clusters_id)
+            sobj <- rename_idents(sobj, over_clustering, cluster_map)
+        }
+    } else if (!is.null(newcol)) {
+        sobj@meta.data[[newcol]] <- sobj@meta.data[["predicted_labels"]]
+    }
+
+    if (merge_same_labels) {
+        log$info("Merging clusters with the same labels ...")
+        sobj <- merge_clusters_with_same_labels(sobj, newcol)
+    }
+
+    if (!is.null(ident)) {
+        # restore the original identity
+        Idents(sobj) <- ident
+    }
+
+    log$info("Saving the object ...")
+    save_obj(sobj, outfile)
+} else {
+    stop(paste0("Unknown output type: ", outtype))
+}