From 0304a88b29de80320e121be6f8189d81cd6330ac Mon Sep 17 00:00:00 2001 From: vertesy Date: Wed, 25 Sep 2024 19:33:39 +0200 Subject: [PATCH] bf transferMetadata --- R/Seurat.Utils.Metadata.R | 40 +++++++++++++++++++++++++--------- R/Seurat.Utils.R | 16 ++++++++------ R/Seurat.Utils.Visualization.R | 2 +- man/dot-parseKeyParams.Rd | 3 ++- man/runDGEA.Rd | 3 +++ man/transferMetadata.Rd | 11 ++++++---- man/xsave.Rd | 3 ++- 7 files changed, 54 insertions(+), 24 deletions(-) diff --git a/R/Seurat.Utils.Metadata.R b/R/Seurat.Utils.Metadata.R index 1666fd8..b5646f0 100644 --- a/R/Seurat.Utils.Metadata.R +++ b/R/Seurat.Utils.Metadata.R @@ -801,12 +801,13 @@ saveLsSeuratMetadata <- function(ls.obj, suffix) { #' @param colname_to Vector of names for the columns in the destination object's metadata. #' Defaults to the same names as `colname_from`. Must be the same length as `colname_from` unless #' it is the same as `colname_from`. -#' @param verbose Logical, indicating whether to print details about the transfer, including the -#' number and percentage of matching cells between objects, and unique cells in each object. #' @param overwrite Logical, indicating whether to overwrite the column in the destination object #' if it already exists. Defaults to FALSE. #' @param plotUMAP Logical, indicating whether to plot UMAPs of the destination object with #' the new identity. +#' @param strict Logical, indicating whether to fail if the destination object have cells not found in the source object. +#' @param verbose Logical, indicating whether to print details about the transfer, including the +#' number and percentage of matching cells between objects, and unique cells in each object. #' @param ... Additional arguments to be passed to `transferMetadata`. #' #' @return Returns the destination Seurat object (`to`) with the new metadata columns added. @@ -829,9 +830,10 @@ saveLsSeuratMetadata <- function(ls.obj, suffix) { transferMetadata <- function(from, to, colname_from, colname_to = colname_from, - verbose = TRUE, overwrite = FALSE, plotUMAP = TRUE, + strict = TRUE, + verbose = TRUE, ...) { # stopifnot( @@ -847,8 +849,9 @@ transferMetadata <- function(from, to, cells_only_in_from <- setdiff(colnames(from), colnames(to)) cells_only_in_to <- setdiff(colnames(to), colnames(from)) nr.cells.both <- length(cells_in_both) - nr.cells.from <- length(cells_only_in_from) - nr.cells.to <- length(cells_only_in_to) + nr.cells.only.from <- length(cells_only_in_from) + nr.cells.only.to <- length(cells_only_in_to) + # Print cell overlap information _______________________________________________________ @@ -860,20 +863,38 @@ transferMetadata <- function(from, to, ) cat( "Cells only in obj1 (from):", length(cells_only_in_from), - "(", sprintf("%.2f%%", nr.cells.from / length(colnames(from)) * 100), ")\n" + "(", sprintf("%.2f%%", nr.cells.only.from / length(colnames(from)) * 100), ")\n" ) cat( - "Cells only in obj2 (to):", nr.cells.to, - "(", sprintf("%.2f%%", nr.cells.to / length(colnames(to)) * 100), ")\n" + "Cells only in obj2 (to):", nr.cells.only.to, + "(", sprintf("%.2f%%", nr.cells.only.to / length(colnames(to)) * 100), ")\n" ) } + if(strict) { + stopifnot("There are cells ONLY present in the destination object. Cannot transfer metadata." = (nr.cells.only.to == 0) ) + } else { + warning("There are cells ONLY present in the destination object. Filled with NA", immediate. = TRUE) + } + + if(nr.cells.only.from > 0 & verbose) warning("There are cells ONLY present in the FROM object. These will be ignored.", immediate. = TRUE) + + # Transfer metadata columns _______________________________________________________ for (i in seq_along(colname_from)) { + + # Check if to-column exists in destination object OR you overwrite anyway if (!(colname_to[i] %in% colnames(to@meta.data)) || overwrite) { + + # Check if column exists in source object if (colname_from[i] %in% colnames(from@meta.data)) { + # Transfer the metadata column - to[[colname_to[i]]] <- from[[colname_from[i]]] + # to[[colname_to[i]]] <- from[[colname_from[i]]] + + metadata_from <- getMetadataColumn(obj = from, col = colname_from[i]) + to <- addMetaDataSafe(obj = to, col.name = colname_to[i], metadata = metadata_from[colnames(to)]) + message(sprintf("Transferred '%s' to '%s'.", colname_from[i], colname_to[i])) } else { warning(sprintf("Column '%s' not found in source object.", colname_from[i]), immediate. = TRUE) @@ -887,7 +908,6 @@ transferMetadata <- function(from, to, # Plot umap _______________________________________________________ if (plotUMAP) { - # browser() x <- clUMAP(obj = to, ident = colname_to[i], suffix = "transferred.ident", ...) print(x) } diff --git a/R/Seurat.Utils.R b/R/Seurat.Utils.R index e4ffdcc..c6a8e8c 100644 --- a/R/Seurat.Utils.R +++ b/R/Seurat.Utils.R @@ -5412,9 +5412,10 @@ compareVarFeaturesAndRanks <- function( #' @param v Verbose? Default: `TRUE`. #' #' @return Integer representing the number of scaled features -.getNrScaledFeatures <- function(obj, assay = Seurat::DefaultAssay(obj), v = TRUE) { - message(" > Running .getNrScaledFeatures...") - message("Seurat version: ", obj@version, " | Assay searched: ", assay) +.getNrScaledFeatures <- function(obj, assay = Seurat::DefaultAssay(obj), + v = TRUE) { + if(v) message(" > Running .getNrScaledFeatures...") + if(v) message("Seurat version: ", obj@version, " | Assay searched: ", assay) layers.found <- Layers(obj, assay = assay) if("scale.data" %in% layers.found) { @@ -5529,13 +5530,14 @@ compareVarFeaturesAndRanks <- function( nrVarFeatures = NULL, return.as.name = FALSE, assay = Seurat::DefaultAssay(obj), - suffix = NULL) { + suffix = NULL, + v = T) { # # browser() - message(" > Running .parseKeyParams...") - scaledFeatures <- .getNrScaledFeatures(obj, assay) + if(v) message(" > Running .parseKeyParams...") + scaledFeatures <- .getNrScaledFeatures(obj, assay, v= F) - if (is.null(regressionVariables)) regressionVariables <- .getRegressionVariablesForScaleData(obj = obj, assay = assay) + if (is.null(regressionVariables)) regressionVariables <- .getRegressionVariablesForScaleData(obj = obj, assay = assay, v = F) if (!is.null(nrVarFeatures)) { if (nrVarFeatures != scaledFeatures) { diff --git a/R/Seurat.Utils.Visualization.R b/R/Seurat.Utils.Visualization.R index 2231ee8..0128be5 100644 --- a/R/Seurat.Utils.Visualization.R +++ b/R/Seurat.Utils.Visualization.R @@ -2312,7 +2312,7 @@ clUMAP <- function( PCT <- percentage_formatter(length(highlight.these) / ncol(obj), suffix = "or") if (is.null(sub)) sub <- paste(PCT, length(highlight.these), "cells in ", ident) - title <- kppc(highlight.clusters) + title <- kpipe(ident, kppc(highlight.clusters)) } else { highlight.these <- NULL } diff --git a/man/dot-parseKeyParams.Rd b/man/dot-parseKeyParams.Rd index e9640a6..79c81a0 100644 --- a/man/dot-parseKeyParams.Rd +++ b/man/dot-parseKeyParams.Rd @@ -10,7 +10,8 @@ nrVarFeatures = NULL, return.as.name = FALSE, assay = Seurat::DefaultAssay(obj), - suffix = NULL + suffix = NULL, + v = T ) } \arguments{ diff --git a/man/runDGEA.Rd b/man/runDGEA.Rd index 2cc792d..5fc8d05 100644 --- a/man/runDGEA.Rd +++ b/man/runDGEA.Rd @@ -18,6 +18,7 @@ runDGEA( save.obj = TRUE, calculate.DGEA = TRUE, plot.DGEA = TRUE, + umap_caption = "", plot.av.enrichment.hist = TRUE, plot.log.top.gene.stats = TRUE, auto.cluster.naming = TRUE, @@ -64,6 +65,8 @@ Default: TRUE.} \item{plot.DGEA}{Logical determining if results should be plotted. Default: TRUE.} +\item{umap_caption}{Character string specifying the caption for the UMAP plot. Default: "".} + \item{plot.av.enrichment.hist}{Logical indicating whether to plot the average enrichment histogram. Default: TRUE.} diff --git a/man/transferMetadata.Rd b/man/transferMetadata.Rd index 83100e3..7b77e99 100644 --- a/man/transferMetadata.Rd +++ b/man/transferMetadata.Rd @@ -9,9 +9,10 @@ transferMetadata( to, colname_from, colname_to = colname_from, - verbose = TRUE, overwrite = FALSE, plotUMAP = TRUE, + strict = TRUE, + verbose = TRUE, ... ) } @@ -26,15 +27,17 @@ transferMetadata( Defaults to the same names as \code{colname_from}. Must be the same length as \code{colname_from} unless it is the same as \code{colname_from}.} -\item{verbose}{Logical, indicating whether to print details about the transfer, including the -number and percentage of matching cells between objects, and unique cells in each object.} - \item{overwrite}{Logical, indicating whether to overwrite the column in the destination object if it already exists. Defaults to FALSE.} \item{plotUMAP}{Logical, indicating whether to plot UMAPs of the destination object with the new identity.} +\item{strict}{Logical, indicating whether to fail if the destination object have cells not found in the source object.} + +\item{verbose}{Logical, indicating whether to print details about the transfer, including the +number and percentage of matching cells between objects, and unique cells in each object.} + \item{...}{Additional arguments to be passed to \code{transferMetadata}.} } \value{ diff --git a/man/xsave.Rd b/man/xsave.Rd index a919be5..0d2629e 100644 --- a/man/xsave.Rd +++ b/man/xsave.Rd @@ -17,7 +17,8 @@ xsave( saveParams = if (exists("p")) TRUE else FALSE, paramList = if (exists("p")) p else NULL, allGenes = if (exists("all.genes")) all.genes else NULL, - saveLocation = TRUE + saveLocation = TRUE, + v = TRUE ) } \arguments{