...

R/Seurat.Utils.Metadata.R

@@ -386,19 +386,30 @@ addMetaDataSafe <- function(obj, metadata, col.name, overwrite = FALSE, verbose
   iprint("strict", strict)
   if (strict) stopifnot("Metadata or object too short" = equal_length)
 
-
   if (!is.null(names(metadata))) {
-    if (verbose) print(head(names(metadata)))
-    if (verbose) print(head(colnames(obj)))
+    if (verbose) {
+
+      iprint("cells in metadata:", head(names(metadata)), "...")
+      iprint("cells in object:", head(colnames(obj)), "...")
+    }
     if (strict) stopifnot(names(metadata) == colnames(obj))
+
   } else {
     message("No CBCs associated with new metadata. Assuming exact match.")
     if (!equal_length) stop("Not equal lenght, no CBCs")
-    names(metadata) <- colnames(obj)
+  }
+
+  if (any(is.na(names(metadata))) ) {
+    warning("Metadata contains NA values.", immediate. = T)
+    metadata_orig <- metadata
+    metadata <- vec.fromNames(colnames(obj), fill = NA)
+    cells_found <- na.omit.strip(names(metadata_orig))
+    metadata[cells_found] <- metadata_orig[cells_found]
   }
 
   # Perform the operation
-  obj <- Seurat::AddMetaData(object = obj, metadata = metadata, col.name = col.name)
+  stopif(any(is.na(names(metadata))))
+  obj <- Seurat::AddMetaData(object = obj, metadata = metadata, col.name = col.name )
 
   prefix <- paste("New column", col.name)
   # Check for NA or NaN values
@@ -854,6 +865,8 @@ transferMetadata <- function(from, to,
       length(colnames_from) == length(colnames_to)
   )
 
+
+
   # Check cell overlaps
   cells_in_both <- intersect(colnames(from), colnames(to))
   cells_only_in_from <- setdiff(colnames(from), colnames(to))
@@ -898,20 +911,20 @@ transferMetadata <- function(from, to,
 
       # Check if column exists in source object
       if (colnames_from[i] %in% colnames(from@meta.data)) {
-
         # Transfer the metadata column
         # to[[colnames_to[i]]] <- from[[colnames_from[i]]]
 
         metadata_from <- getMetadataColumn(obj = from, col = colnames_from[i])
         to <- addMetaDataSafe(
           obj = to, col.name = colnames_to[i], metadata = metadata_from[colnames(to)],
-          strict = strict
+          strict = strict, verbose = verbose
         )
 
         message(sprintf("Transferred '%s' to '%s'.", colnames_from[i], colnames_to[i]))
       } else {
         warning(sprintf("Column '%s' not found in source object.", colnames_from[i]), immediate. = TRUE)
       }
+
     } else {
       warning(sprintf(
         "Column '%s' already exists in destination object. Set 'overwrite = TRUE' to overwrite.",

R/Seurat.Utils.Visualization.R

@@ -2138,25 +2138,18 @@ qUMAP <- function(
     caption = .parseBasicObjStats(obj, simple = TRUE),
     ...) {
   #
-  stopifnot(is(obj) == "Seurat")
   message("Feature: ", feature, " | Assay: ", assay)
-
-  if (feature %in% colnames(obj@meta.data)) {
-    message(paste("...found in @meta.data."))
-    stopifnot(is.numeric(obj@meta.data[, feature]))
-  }
-
-  if (check_for_2D) {
-    umap_dims <- ncol(obj@reductions[[reduction]]@cell.embeddings)
-    if (umap_dims != 2) warning(">>> UMAP is not 2 dimensional! \n Check obj@reductions[[reduction]]@cell.embeddings")
-  }
-
-  if (!(feature %in% colnames(obj@meta.data) | feature %in% Features(obj, assay = assay))) {
-    feature <- check.genes(
-      list.of.genes = feature, obj = obj, verbose = FALSE,
-      HGNC.lookup = HGNC.lookup, makeuppercase = make.uppercase
-    )
-  }
+  META <- obj@meta.data
+  stopifnot(is(obj) == "Seurat", is.character(feature),
+            "Feature not found in genes / meta.data."  = feature %in% c(Features(obj, assay = assay) , colnames(META)),
+            "meta.data column is not numeric"  = if(feature %in% colnames(META)) is.numeric(META[, feature]) else TRUE,
+            "UMAP is not 2 dimensional! \n Check obj@reductions[[reduction]]@cell.embeddings" =
+              if (check_for_2D) ncol(obj@reductions[[reduction]]@cell.embeddings) == 2,
+            reduction %in% names(obj@reductions),
+            assay %in% names(combined.obj@assays),
+            "split.by column not found in meta.data / not categorical" =
+              if (!is.null(splitby)) {splitby %in% colnames(META) && is.factor(META[[splitby]]) || is.character(META[[splitby]])} else TRUE
+            )
 
   DefaultAssay(obj) <- assay
   gg.obj <- Seurat::FeaturePlot(obj,
@@ -2520,7 +2513,7 @@ multiFeaturePlot.A4 <- function(
     list.of.genes,
     obj = combined.obj,
     subdir = TRUE,
-    foldername = substitute_deparse(list.of.genes),
+    foldername = substitute(list.of.genes),
     subtitle.from.names = TRUE,
     plot.reduction = "umap",
     intersectionAssay = c("RNA", "integrated")[1],
@@ -2547,7 +2540,7 @@ multiFeaturePlot.A4 <- function(
   if (is.null(names(list.of.genes))) subtitle.from.names <- FALSE
 
   list.of.genes.found <- check.genes(
-    list.of.genes = list.of.genes, obj = obj,
+    genes = list.of.genes, obj = obj,
     assay.slot = intersectionAssay, makeuppercase = FALSE
   )
   if (subtitle.from.names) names(list.of.genes.found) <- as.character(flip_value2name(list.of.genes)[list.of.genes.found])
@@ -2921,7 +2914,7 @@ plotQUMAPsInAFolder <- function(genes, obj = combined.obj,
   MarkdownReports::create_set_SubDir(paste0(foldername, "-", plot.reduction), "/")
 
   list.of.genes.found <- check.genes(
-    list.of.genes = genes, obj = obj,
+    genes = genes, obj = obj,
     assay.slot = intersectionAssay, makeuppercase = FALSE
   )
 
@@ -3885,7 +3878,8 @@ save2plots.A4 <- function(
   p1 <- cowplot::ggdraw(p1) +
     theme(plot.background = element_rect(fill = "white", color = NA))
 
-  iprint("Saved as:", pname)
+  print("Saved as:")
+  MarkdownHelpers::ww.FnP_parser(extPNG(pname))
 
   save_plot(plot = p1, filename = extPNG(pname), base_height = h, base_width = w)
 }
@@ -3937,7 +3931,7 @@ save4plots.A4 <- function(
     theme(plot.background = element_rect(fill = "white", color = NA))
 
   iprint("Saved as:", pname)
-  # fname <- MarkdownHelpers::ww.FnP_parser(extPNG(pname) )
+  MarkdownHelpers::ww.FnP_parser(extPNG(pname))
   save_plot(plot = p1, filename = extPNG(pname), base_height = h, base_width = w)
 }
 
@@ -3975,11 +3969,11 @@ qqSaveGridA4 <- function(
   iprint(NrPlots, "plots found,", plots, "are saved.")
   pg.cf <- cowplot::plot_grid(plotlist = plotlist[plots], nrow = 2, ncol = NrPlots / 2, labels = LETTERS[1:NrPlots], ...)
   if (NrPlots == 4) list2env(list(height = width, width = height), envir = as.environment(environment()))
+  MarkdownHelpers::ww.FnP_parser(fname)
   save_plot(
     filename = fname,
     plot = pg.cf, base_height = height, base_width = width
   )
-  MarkdownHelpers::ww.FnP_parser(fname)
 }