From 61a829e79bdff55fe47f0618b8262294d6768b29 Mon Sep 17 00:00:00 2001
From: Stu Field <stu.g.field@gmail.com>
Date: Fri, 9 Feb 2024 14:35:40 -0700
Subject: [PATCH] Update transform() and scaleAnalytes()

- scaleAnalytes() now skips missing references
---
 R/s3-transform.R                    |  4 +-
 R/scaleAnalytes.R                   | 24 ++++++-----
 tests/testthat/test-scaleAnalytes.R | 62 +++++++++++++++++++++++++++++
 3 files changed, 77 insertions(+), 13 deletions(-)
 create mode 100644 tests/testthat/test-scaleAnalytes.R

diff --git a/R/s3-transform.R b/R/s3-transform.R
index 146bd14..e8d244f 100644
--- a/R/s3-transform.R
+++ b/R/s3-transform.R
@@ -61,10 +61,10 @@ transform.soma_adat <- function(`_data`, v, dim = 2L, ...) {
   .apts <- getAnalytes(x)
   if ( dim == 2L ) {
     stopifnot(length(v) == length(.apts))   # check cols
-    x[, .apts] <- t( t(x[, .apts]) * v )
+    x[, .apts] <- t( t(x[, .apts, drop = FALSE]) * v )
   } else {
     stopifnot(length(v) == nrow(x))         # check rows
-    x[, .apts] <- as.matrix(x[, .apts]) * v
+    x[, .apts] <- as.matrix(x[, .apts, drop = FALSE]) * v
   }
   x
 }
diff --git a/R/scaleAnalytes.R b/R/scaleAnalytes.R
index e58304a..2da8e87 100644
--- a/R/scaleAnalytes.R
+++ b/R/scaleAnalytes.R
@@ -1,18 +1,19 @@
 #' Scale/transform Analyte RFUs
 #'
 #' Scale analytes by a scalar reference value with `SeqId` names to
-#' match with the analytes contained in `.data`.
+#' match with the analytes contained in `.data`. Columns without a
+#' corresponding reference value are not modified (with a warning).
 #'
 #' @param .data A `soma_adat` class object ... _must_ be a `soma_adat` for
 #'   downstream methods to properly dispatch.
 #' @param scale_vec A vector of scalars, named by `SeqId`, see [getSeqId()].
 #' @author Stu Field
 #' @examples
-#' adat <- head(example_data, 3L)
+#' adat <- head(example_data, 3L) |> dplyr::select(id, c(16:18))
 #' apts <- getAnalytes(adat)
-#' ref  <- setNames(rep(1, length(apts)), getSeqId(apts))   # ref = 1.0
+#' ref  <- c("2802-68" = 10.0, "1942-70" = 0.1, "9251-29" = 1.0)
 #' new  <- scaleAnalytes(adat, ref)
-#' identical(new, adat)
+#' new
 #' @importFrom tibble enframe deframe
 #' @noRd
 scaleAnalytes <- function(.data, scale_vec) {
@@ -40,10 +41,10 @@ scaleAnalytes <- function(.data, scale_vec) {
   missing <- setdiff(apts, matches$apts)
   extra   <- setdiff(stbl$SeqId, matches$`stbl$SeqId`)
   if ( length(missing) > 0L ) {
-    stop(
-      "Missing scalar value for ", length(missing), " analytes. ",
-      "Cannot continue.\nPlease check the reference scalars, their names, ",
-      "or the annotations file to proceed.",
+    warning(
+      "Missing scalar value for (", length(missing), ") analytes. ",
+      "They will not be transformed.\n",
+      "Please check the reference or its named SeqIds.",
       call. = FALSE
     )
   }
@@ -58,9 +59,10 @@ scaleAnalytes <- function(.data, scale_vec) {
   svec <- deframe(stbl)               # return to named vector
   svec <- svec[matches$`stbl$SeqId`]  # order reference to the adat
 
-  # should now be identical
-  stopifnot(identical(getSeqId(apts), names(svec)))
+  stopifnot(all(names(svec) %in% getSeqId(apts)))
 
   # apply svec scalars by column
-  transform(.data, unname(svec))
+  new <- transform(.data[, matches$apts, drop = FALSE], unname(svec))
+  .data[, matches$apts] <- data.frame(new, row.names = NULL)
+  .data
 }
diff --git a/tests/testthat/test-scaleAnalytes.R b/tests/testthat/test-scaleAnalytes.R
new file mode 100644
index 0000000..e73bbfc
--- /dev/null
+++ b/tests/testthat/test-scaleAnalytes.R
@@ -0,0 +1,62 @@
+
+# Setup ----
+adat <- example_data
+apts <- getAnalytes(adat)
+short_adat <- head(adat[, c(getMeta(adat), head(apts, 3L))], 3L)
+
+# this is to ensure the S3 method is available and dispatched
+# otherwise the base::transform.data.frame() method will not
+# transform the analytes inside scaleAnalytes()
+
+test_that("the transform() S3 method exists in the namespace", {
+  SomaGlobals::expect_error_free(getS3method("transform", "soma_adat"))
+})
+
+test_that("the transform() S3 method is listed in methods", {
+  methods <- unclass(methods("transform", "soma_adat"))
+  expect_true("transform.soma_adat" %in% methods)
+})
+
+
+# Testing ----
+test_that("`scaleAnalytes()` returns identical adat when scalars are 1.0", {
+  ref <- setNames(rep(1.0, length(apts)), getSeqId(apts))
+  a <- scaleAnalytes(adat, ref)
+  expect_equal(adat, a)
+})
+
+test_that("a warning is triped if reference is missing any features", {
+  ref <- setNames(rep(1.0, length(apts)), getSeqId(apts))
+  ref <- head(ref, -3L)   # rm 3 seqids from end
+  expect_length(ref, length(apts) - 3L)
+  expect_snapshot( new <- scaleAnalytes(adat, ref) )
+})
+
+test_that("a subset adat can be transformed", {
+  # extra scaling analytes in reference:
+  #   sample() ensures ref is out of sync with short_adat analytes
+  ref <- setNames(rep(1.0, length(apts)), sample(getSeqId(apts)))
+  expect_warning(
+    a <- scaleAnalytes(short_adat, ref),
+    "There are extra scaling values (37) in the reference.",
+    fixed = TRUE
+  )
+  expect_equal(short_adat, a)
+})
+
+test_that("specific analytes are scaled with non-1.0 values", {
+  # extra scaling analytes in reference
+  ref <- setNames(c(0.75, 1.1, 1.25), getSeqId(getAnalytes(short_adat)))
+  # re-order puts reference out of order; ensures SeqId matching must happen
+  ref <- ref[c(2, 3, 1L)]
+  a <- scaleAnalytes(short_adat, ref)
+  expect_s3_class(a, "soma_adat")
+  expect_equal(a$seq.2802.68, short_adat$seq.2802.68 * 0.75)
+  expect_equal(a$seq.9251.29, short_adat$seq.9251.29 * 1.10)
+  expect_equal(a$seq.1942.70, short_adat$seq.1942.70 * 1.25)
+})
+
+test_that("`scaleAnalytes()` only accepts the `soma_adat` class", {
+  bad_adat <- as.data.frame(short_adat)
+  expect_snapshot(scaleAnalytes(bad_adat), error = TRUE)
+})