Restructure of lift_adat() functionality

- `lift_adat()` now takes a `bridge =` argument,
  replacing the `anno.tbl =` argument. Lifting
  is now performed internally for a better (and safer)
  user experience, without the necessity of an
  external annotations file. Much simpler user experience.
- the majority of this refactoring was internal
  and the user should not experience a major
  disruption to the API.
- new internal objects `lift_master` and `lref`
  as sources of internal scaling factors (lifting)
- new function `is_lifted()`
- fixes SomaLogic#81, fixes SomaLogic#78

NAMESPACE

@@ -81,6 +81,7 @@ export(getFeatures)
 export(getMeta)
 export(getSeqId)
 export(getSeqIdMatches)
+export(getSignalSpace)
 export(getSomaScanVersion)
 export(getSomamerData)
 export(getSomamers)
@@ -93,6 +94,7 @@ export(is.apt)
 export(is.intact.attributes)
 export(is.soma_adat)
 export(is_intact_attr)
+export(is_lifted)
 export(is_seqFormat)
 export(left_join)
 export(lift_adat)
@@ -144,6 +146,8 @@ importFrom(dplyr,ungroup)
 importFrom(lifecycle,deprecate_soft)
 importFrom(lifecycle,deprecate_stop)
 importFrom(lifecycle,deprecate_warn)
+importFrom(lifecycle,deprecated)
+importFrom(lifecycle,is_present)
 importFrom(magrittr,"%>%")
 importFrom(methods,new)
 importFrom(methods,setGeneric)

R/adat-helpers.R

@@ -62,12 +62,6 @@ getAdatVersion <- function(atts) {
 }
 
 
-.ss_ver_map <- c(v3 = "1129", v3.0 = "1129",
-                 v4 = "5k", v4.0 = "5k",
-                 v4.1 = "7k",
-                 v5  = "11k", v5.0 = "11k")
-
-
 #' Gets the SomaScan version
 #'
 #' @rdname adat-helpers
@@ -82,6 +76,20 @@ getSomaScanVersion <- function(adat) {
 }
 
 
+#' Gets the SomaScan Signal Space
+#'
+#' @rdname adat-helpers
+#' @inheritParams params
+#' @examples
+#'
+#' rfu_space <- getSignalSpace(example_data)
+#' rfu_space
+#' @export
+getSignalSpace <- function(adat) {
+  attr(adat, "Header.Meta")$HEADER$SignalSpace %||% getSomaScanVersion(adat)
+}
+
+
 #' Checks the SomaScan version
 #'
 #' @rdname adat-helpers
@@ -92,7 +100,7 @@ getSomaScanVersion <- function(adat) {
 #' is.null(checkSomaScanVersion(ver))
 #' @export
 checkSomaScanVersion <- function(ver) {
-  allowed <- c("v3.0", "v4", "v4.0", "v4.1", "v5", "v5.0")
+  allowed <- c("v4", "v4.0", "v4.1", "v5", "v5.0")
   if ( !tolower(ver) %in% allowed ) {
     stop("Unsupported assay version: ", .value(ver),
          ". Supported versions: ", .value(allowed), call. = FALSE)

R/lift-adat.R

@@ -17,52 +17,62 @@
 #' Likewise, "lifting" from `v4.0` -> `v4.1` requires
 #' a separate annotations file and a `soma_adat` from SomaScan `v4.0`.
 #'
-#' @param adat A `soma_adat` class object.
-#' @param anno.tbl A table of annotations, typically the result of a call
-#'   to [read_annotations()].
+#' @inheritParams params
+#' @param bridge The direction of the lift (i.e. bridge).
+#' @param anno.tbl Deprecated.
 #' @return A "lifted" `soma_adat` object corresponding to the scaling
 #'   reference in the `anno.tbl`. RFU values are rounded to 1 decimal to
 #'   match standard SomaScan delivery format.
 #' @examples
-#' # `example_data` is SomaScan V4
+#' # `example_data` is SomaScan V4 (5k)
 #' adat <- head(example_data, 3L)
-#'
-#' # read in version specific annotations file
-#' # containing scaling values between assay versions
-#' \dontrun{
-#' tbl <- read_annotations("path/to/annotations_file.xlsx")
-#' }
-#'
-#' # mock annotations table in lieu of `*.xlsx` file
-#' tbl <- tibble::tibble(SeqId = getSeqId(getAnalytes(adat)),
-#'                      "Plasma Scalar v4.0 to v4.1" = 1)   # scale by 1.0
-#' # usually performed inside `read_annotations()`
-#' # assign valid testing version to annotations table
-#' attr(tbl, "version") <- "SL-99999999-rev99-1999-01"
+#' getSomaScanVersion(example_data)
 #'
 #' # perform the 'lifting'
-#' lifted <- lift_adat(adat, tbl)
-#'
-#' # `tbl` contained all scalars = 1.0 (same RFUs)
-#' all.equal(adat, lifted, check.attributes = FALSE)
+#' lift_7k <- lift_adat(adat, "5k_to_7k")
+#' is_lifted(lift_7k)
 #'
 #' # attributes updated to reflect the 'lift'
-#' attr(lifted, "Header")$HEADER$ProcessSteps
-#' attr(lifted, "Header")$HEADER$SignalSpace
+#' attr(lift_7k, "Header")$HEADER$SignalSpace
+#' attr(lift_7k, "Header")$HEADER$ProcessSteps
 #' @importFrom tibble enframe deframe
+#' @importFrom lifecycle deprecated is_present
 #' @export
-lift_adat <- function(adat, anno.tbl) {
+lift_adat <- function(adat,
+                      bridge = c("11k_to_7k", "11k_to_5k",
+                                 "7k_to_11k", "7k_to_5k",
+                                 "5k_to_11k", "5k_to_7k"),
+                      anno.tbl = deprecated()) {
+
+  stopifnot(
+    "`adat` must be a `soma_adat` class object." = inherits(adat, "soma_adat"),
+    "`adat` must have intact attributes."        = is_intact_attr(adat)
+  )
+
+  if ( is_present() ) {
+    deprecate_warn(
+      "6.1.0",
+      "SomaDataIO::lift_adat(anno.tbl =)",
+      "SomaDataIO::lift_adat(bridge =)",
+      details = "Passing 'anno.tbl =' is now unnecessary."
+    )
+  }
 
-  stopifnot(inherits(adat, "soma_adat"))
+  bridge <- match.arg(bridge)  # does a syntax check for allowed params
   atts <- attr(adat, "Header.Meta")$HEADER
-  anno_ver <- attr(anno.tbl, "version")
-  .check_anno(anno_ver)
   .check_anml(atts)
 
+  # the 'space' refers to the SomaScan assay version signal space
+  # prefer SignalSpace if present; NULL if absent
+  from_space <- getSignalSpace(adat)
+  checkSomaScanVersion(from_space)
+  from_space <- map_ver2k[[from_space]]   # map ver to k and strip names
+  new_space  <- .check_direction(from_space, bridge)  # check and return new space
+
   if ( grepl("Plasma", atts$StudyMatrix, ignore.case = TRUE) ) {
-    scalar_col <- ver_dict[[anno_ver]]$col_plasma
+    ref_vec <- .get_lift_ref(matrx = "plasma", bridge = bridge)
   } else if ( grepl("Serum", atts$StudyMatrix, ignore.case = TRUE) ) {
-    scalar_col <- ver_dict[[anno_ver]]$col_serum
+    ref_vec <- .get_lift_ref(matrx = "serum", bridge = bridge)
   } else {
     stop(
       "Unsupported matrix: ", .value(atts$StudyMatrix), ".\n",
@@ -71,92 +81,26 @@ lift_adat <- function(adat, anno.tbl) {
     )
   }
 
-  if ( scalar_col %in% names(anno.tbl) ) {
-    anno.tbl <- anno.tbl[, c("SeqId", scalar_col)]
-  } else {
-    stop(
-      "Unable to find the required 'Scalar' column in the annotations file.\n",
-      "Do you have the correct annotations file?",
-      call. = FALSE
-    )
-  }
-
-  # the 'space' refers to the assay version signal space
-  from_space <- atts$SignalSpace      # prefer this; NULL if absent
-  if ( is.null(from_space) ) {
-    from_space <- atts$AssayVersion   # if missing; use this
-  }
-
-  .check_ver(from_space)
-  .check_direction(scalar_col, from_space)
-
-  new_space <- gsub(".*(v[0-9]\\.[0-9])$", "\\1", scalar_col)
-  attr(adat, "Header.Meta")$HEADER$SignalSpace <- new_space
-  new_step <- sprintf("Annotation Lift (%s to %s)", tolower(from_space), new_space)
+  # update attrs with new SignalSpace information
+  attr(adat, "Header.Meta")$HEADER$SignalSpace  <- map_k2ver[[new_space]]
+  new_step <- sprintf("Lifting Bridge (%s -> %s)", tolower(from_space), new_space)
   steps    <- attr(adat, "Header.Meta")$HEADER$ProcessSteps
   attr(adat, "Header.Meta")$HEADER$ProcessSteps <- paste0(steps, ", ", new_step)
-  ref_vec <- deframe(anno.tbl)
   scaleAnalytes(adat, ref_vec) |> round(1L)
 }
 
 
-
-# Checks ----
-# check attributes of annotations tbl for a version
-# x = annotations version from annotations tbl
-.check_anno <- function(x) {
-  if ( is.null(x) ) {
-    stop("Unable to determine the Annotations file version in `anno.tbl`.\n",
-         "Please check the attributes via `attr(anno.tbl, 'version')`.",
-         call. = FALSE)
-  }
-  if ( !x %in% names(ver_dict) ) {
-    stop("Unknown Annotations file version from `anno.tbl`: ", .value(x),
-         "\nUnable to proceed without knowing annotations table specs.",
-         call. = FALSE)
-  }
-  invisible(NULL)
-}
-
-# check that SomaScan data has been ANML normalized
-# x = Header attributes
-.check_anml <- function(x) {
-  steps <- x$ProcessSteps
-  if ( is.null(steps) | !grepl("ANML", steps, ignore.case = TRUE) ) {
-    stop("ANML normalized SOMAscan data is required for lifting.",
-         call. = FALSE)
-  }
-  invisible(NULL)
-}
-
-# check supported versions: v4, v4.0, v4.1
-.check_ver <- function(ver) {
-  allowed <- c("v4", "v4.0", "v4.1")
-  if ( !tolower(ver) %in% allowed ) {
-    stop(
-      "Unsupported assay version: ", .value(ver),
-      ". Supported versions: ", .value(allowed), call. = FALSE
-    )
-  }
-  invisible(NULL)
-}
-
-#' @param x the name of the scalar column from the annotations table.
-#' @param y the assay version from the adat header information.
-#' @noRd
-.check_direction <- function(x, y) {
-  y <- tolower(y)
-  if ( grepl("4\\.1.*4\\.0", x) & y == "v4" ) {
-    stop(
-      "Annotations table indicates v4.1 -> v4.0, however the ADAT object ",
-      "already appears to be in version ", y, " space.", call. = FALSE
-    )
-  }
-  if ( grepl("4\\.0.*4\\.1", x) & y == "v4.1" ) {
-    stop(
-      "Annotations table indicates v4.0 -> v4.1, however the ADAT object ",
-      "already appears to be in version ", y, " space.", call. = FALSE
-    )
-  }
-  invisible(NULL)
+#' Test for lifted objects
+#'
+#' [is_lifted()] checks whether an object
+#' has been lifted (bridged) by the presence
+#' (or absence) of the `SignalSpace` entry
+#' in the `soma_adat` attributes.
+#'
+#' @rdname lift_adat
+#' @return Logical. Whether `adat` has been lifted.
+#' @export
+is_lifted <- function(adat) {
+  x <- attr(adat, "Header.Meta")$HEADER
+  !is.null(x$SignalSpace)
 }

R/s3-print-soma-adat.R

@@ -23,13 +23,15 @@ print.soma_adat <- function(x, show_header = FALSE, ...) {
   col_f       <- if ( attsTRUE ) cr_green else cr_red
   atts_symbol <- if ( attsTRUE ) symb_tick else symb_cross
   meta   <- getMeta(x)
-  ver    <- getSomaScanVersion(x) %||% "unknown"
-  ver    <- sprintf("%s (%s)", ver, .ss_ver_map[tolower(ver)])
+  ver    <- getSomaScanVersion(x)
+  ver    <- sprintf("%s (%s)", ver, slug_version(ver))
+  signal <- slug_version(getSignalSpace(x))
   n_apts <- getAnalytes(x, n = TRUE)
   pad    <- strrep(" ", 5L)
-  dim_vars <- c("SomaScan version", "Attributes intact", "Rows",
+  dim_vars <- c("SomaScan version", "Signal Space", "Attributes intact", "Rows",
                 "Columns", "Clinical Data", "Features")
-  dim_vals <- c(ver, col_f(atts_symbol), nrow(x), ncol(x), length(meta), n_apts)
+  dim_vals <- c(ver, signal, col_f(atts_symbol), nrow(x), ncol(x),
+                length(meta), n_apts)
   if ( inherits(x, "grouped_df") && !is.null(attr(x, "groups")) ) {
     dim_vars <- c(dim_vars, "Groups")
     group_data <- attr(x, "groups")
@@ -85,3 +87,10 @@ print.soma_adat <- function(x, show_header = FALSE, ...) {
   writeLines(cli_rule(line = 2, line_col = "green"))
   invisible(x)
 }
+
+# map internal version to
+# external commercial name
+slug_version <- function(x) {
+  ver <- x %||% "unknown"
+  map_ver2k[tolower(ver)]
+}

R/utils-lift.R

@@ -0,0 +1,67 @@
+
+# map external commercial names to
+# internal SomaScan version names
+# ----------------------------------
+map_ver2k <- c(
+  V3   = "1129k",
+  v3   = "1129k",
+  v3.0 = "1129k",
+  V4   = "5k",
+  v4   = "5k",
+  v4.0 = "5k",
+  V4.1 = "7k",
+  v4.1 = "7k",
+  V5   = "11k",
+  v5   = "11k",
+  v5.0 = "11k"
+)
+
+map_k2ver <- c("1129" = "v3.0", "5k" = "v4.0", "7k" = "v4.1", "11k" = "v5.0")
+
+# matrx: either serum or plasma
+# bridge: direction of the bridge
+.get_lift_ref <- function(matrx = c("plasma", "serum"), bridge) {
+  matrx <- match.arg(matrx)
+  df <- lref[[matrx]][, c("SeqId", bridge)]
+  setNames(df[[2L]], df[[1L]])
+}
+
+
+# Checks ----
+# check that SomaScan data has been ANML normalized
+# x = Header attributes
+.check_anml <- function(x) {
+  steps <- x$ProcessSteps
+  if ( is.null(steps) | !grepl("ANML", steps, ignore.case = TRUE) ) {
+    stop("ANML normalized SOMAscan data is required for lifting.",
+         call. = FALSE)
+  }
+  invisible(NULL)
+}
+
+#' @param x the 'from' space.
+#' @param y the bridge variable, e.g. '5k_to_7k'.
+#' @return The 'to' space, from the 'y' param.
+#' @noRd
+.check_direction <- function(x, y) {
+  x <- tolower(x)
+  from <- gsub("(.*)_to_(.*)$", "\\1", y)
+  to <- gsub("(.*)_to_(.*)$", "\\2", y)
+
+  if ( isFALSE(x == from) ) {
+    stop(
+      "You have indicated a bridge from ", .value(from),
+      " space, however your RFU data appears to be in ",
+      .value(x), " space.", call. = FALSE
+    )
+  }
+  if ( isTRUE(x == to) ) {
+    stop(
+      "You have indicated a bridge to ", .value(to),
+      " space, however your RFU data already appears to be in ",
+      .value(x), " space.", call. = FALSE
+    )
+  }
+
+  invisible(to)
+}