apply 'adjustment's to metadata targets

dtm2451 · dtm2451 · Sep 24, 2024 · Sep 24, 2024 · Sep 24, 2024 · 562cf93e1faccccf2c8e24881ab8e6e3f0e7d3b3
commit 562cf93e1faccccf2c8e24881ab8e6e3f0e7d3b3
diff --git a/NAMESPACE b/NAMESPACE
@@ -67,6 +67,7 @@ importFrom(pheatmap,pheatmap)
 importFrom(stats,as.formula)
 importFrom(stats,median)
 importFrom(stats,sd)
+importFrom(stats,setNames)
 importFrom(utils,modifyList)
 importFrom(utils,packageVersion)
 importFrom(utils,read.table)
diff --git a/R/ColorAdjustments.R b/R/ColorAdjustments.R
@@ -2,7 +2,7 @@
 #' Darkens input colors by a set amount
 #'
 #' @description A wrapper for the darken function of the colorspace package.
-#' @param colors the color(s) input. Can be a list of colors, for example, /code{dittoColors()}.
+#' @param colors the color(s) input. Can be a list of colors, for example, \code{dittoColors()}.
 #' @param percent.change # between 0 and 1. the percentage to darken by. Defaults to 0.25 if not given.
 #' @param relative TRUE/FALSE. Whether the percentage should be a relative change versus an absolute one. Default = TRUE.
 #' @return Return a darkened version of the color in hexadecimal color form (="#RRGGBB" in base 16)
@@ -23,7 +23,7 @@ Darken <- function(colors, percent.change = 0.25, relative = TRUE) {
 #' Lightens input colors by a set amount
 #'
 #' @description A wrapper for the lighten function of the colorspace package.
-#' @param colors the color(s) input. Can be a list of colors, for example, /code{dittoColors()}.
+#' @param colors the color(s) input. Can be a list of colors, for example, \code{dittoColors()}.
 #' @param percent.change # between 0 and 1. the percentage to darken by. Defaults to 0.25 if not given.
 #' @param relative TRUE/FALSE. Whether the percentage should be a relative change versus an absolute one. Default = TRUE.
 #' @return Return a lighter version of the color in hexadecimal color form (="#RRGGBB" in base 16)

diff --git a/R/dittoDotPlot.R b/R/dittoDotPlot.R
@@ -597,7 +597,7 @@ dittoDotPlot <- function(
     )
 }
 
-#' @importFrom stats sd
+#' @importFrom stats sd setNames
 .multi_var_gather_raw <- function(
     object,
     vars,
@@ -623,7 +623,18 @@ dittoDotPlot <- function(
     }
 
     gets_data <- if (length(meta_gets)>0) {
-        getMetas(object, names.only = FALSE)[, meta_gets, drop = FALSE]
+        data.frame(
+            setNames(
+                lapply(
+                    meta_gets,
+                    function(m) {
+                        # Individual pulls for applying adjustments
+                        meta(m, object, adjustment, add.names = FALSE)
+                    }
+                ),
+                meta_gets),
+            row.names = .all_cells(object)
+        )
     } else {
         data.frame(row.names = .all_cells(object))
     }

diff --git a/R/meta-getters.R b/R/meta-getters.R
@@ -86,7 +86,7 @@ getMetas <- function(object, names.only = TRUE){
 }
 
 #### meta: for extracting the values of a particular metadata for all cells/samples ####
-#' Returns the values of a meta.data  for all cells/samples
+#' Returns the values of a meta.data for all cells/samples
 #'
 #' @param meta String, the name of the "metadata" slot to grab. OR "ident" to retireve the clustering of a Seurat \code{object}.
 #' @param object A Seurat, SingleCellExperiment, or SummarizedExperiment object.
@@ -100,14 +100,15 @@ getMetas <- function(object, names.only = TRUE){
 #' @param adj.fxn A function which takes a vector (of metadata values) and returns a vector of the same length.
 #' 
 #' For example, \code{function(x) \{log2(x)\}} or \code{as.factor}
-#' @return A named vector.
+#' @param add.names Logical which sets whether cells'/samples' names should be added as names on the output.
+#' @return A vector
 #' @details
 #' Retrieves the values of a metadata slot from \code{object}, or the clustering slot if \code{meta = "ident"} and the \code{object} is a Seurat.
 #' 
 #' If \code{adjustment} or \code{adj.fxn} are provided, then these requested adjustments are applied to these values (\code{adjustment} first).
 #' Note: Alterations via \code{adjustment} are only applied when metadata is numeric, but \code{adj.fxn} alterations are applied to metadata of any type.
 #' 
-#' Lastly, outputs these values are named as the cells'/samples' names.
+#' Lastly, if \code{add.names = TRUE} the values are named as the cells'/samples' names before being output. 
 #' @seealso
 #' \code{\link{metaLevels}} for returning just the unique discrete identities that exist within a metadata slot
 #'
@@ -127,7 +128,7 @@ getMetas <- function(object, names.only = TRUE){
 #' @export
 
 meta <- function(meta, object,
-    adjustment = NULL, adj.fxn = NULL) {
+    adjustment = NULL, adj.fxn = NULL, add.names = TRUE) {
 
     if (!isMeta(meta, object)) {
         stop(dQuote(meta)," is not a metadata of 'object'")
@@ -165,7 +166,9 @@ meta <- function(meta, object,
     }
 
     # Add names
-    names(values) <- .all_cells(object)
+    if (add.names) {
+        names(values) <- .all_cells(object)
+    }
 
     values
 }

diff --git a/R/utils-getters.R b/R/utils-getters.R
@@ -113,7 +113,7 @@
 
     if (length(var)==1 && is.character(var)) {
         if (isMeta(var, object)) {
-            OUT <- meta(var, object)
+            OUT <- meta(var, object, adjustment)
         } else if (isGene(var, object, assay)) {
             OUT <- gene(var, object, assay, slot, adjustment)
         }

diff --git a/man/Darken.Rd b/man/Darken.Rd
diff --git a/man/Lighten.Rd b/man/Lighten.Rd
diff --git a/man/meta.Rd b/man/meta.Rd
diff --git a/tests/testthat/test-getters.R b/tests/testthat/test-getters.R
@@ -1,5 +1,5 @@
 # Tests for visualization functions
-# library(dittoSeq); library(testthat); source("setup.R"); source("../../R/utils.R"); source("../../R/utils-getters.R"); source("../../R/get.reductions.R"); source("../../R/utils-defaulting.R"); source("test-getters.R")
+# library(dittoSeq); library(testthat); for (i in list.files("../../R", pattern="^utils", full.names = TRUE)) source(i); source("test-getters.R")
 
 # Make Seurat, if can
 try(seurat <- Seurat::as.Seurat(sce), silent = TRUE)
@@ -28,7 +28,7 @@ test_that("isMeta works for Seurat and SCE", {
     expect_true(isMeta("score", seurat))
 })
 
-test_that("meta works for Seurat and SCE (+ adjustment/adj.fxn)", {
+test_that("meta works for Seurat and SCE (+ adjustment/adj.fxn, add.names)", {
     expect_type(
         meta("score", sce),
         "double")
@@ -45,6 +45,12 @@ test_that("meta works for Seurat and SCE (+ adjustment/adj.fxn)", {
         factor(meta("score", sce)),
         meta("score", sce, adj.fxn = function(x) {factor(x)}))
 
+    expect_true(is.null(names(meta("age", sce, add.names = FALSE))))
+    expect_equal(
+        names(meta("age", sce)),
+        .all_cells(sce)
+    )
+
     skip_if_not(seurat_conversion_worked, message = "Seurat conversion bug")
     expect_equal(
         meta("score", sce),