wip

- fixes SomaLogic#81

NAMESPACE

@@ -93,6 +93,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 +145,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

R/lift-adat.R

@@ -17,9 +17,9 @@
 #' 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.
@@ -50,19 +50,42 @@
 #' attr(lifted, "Header")$HEADER$ProcessSteps
 #' attr(lifted, "Header")$HEADER$SignalSpace
 #' @importFrom tibble enframe deframe
+#' @importFrom lifecycle deprecated is_present
 #' @export
-lift_adat <- function(adat, anno.tbl) {
+lift_adat <- function(adat,
+                      bridge = c("7k_to_5k", "5k_to_7k",
+                                 "11k_to_7k", "7k_to_11k"),
+                      anno.tbl = deprecated()) {
 
-  stopifnot(inherits(adat, "soma_adat"))
+  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."
+    )
+  }
+
+  bridge <- match.arg(bridge)
   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 <- getSomaScanVersion(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 +94,28 @@ 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]]
+  attr(adat, "Header.Meta")$HEADER$AssayVersion <- map_k2ver[[new_space]]
+  new_step <- sprintf("Lifting Bridge (%s to %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

@@ -24,7 +24,7 @@ print.soma_adat <- function(x, show_header = FALSE, ...) {
   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    <- sprintf("%s (%s)", ver, map_ver2k[tolower(ver)])
   n_apts <- getAnalytes(x, n = TRUE)
   pad    <- strrep(" ", 5L)
   dim_vars <- c("SomaScan version", "Attributes intact", "Rows",

R/utils-lift.R

@@ -0,0 +1,68 @@
+
+# map external commercial names to
+# internal SomaScan version names
+# ----------------------------------
+#  1) bridge     2) lref obj
+# ----------------------------------
+.bridge_map <- c(
+  "7k_to_5k"  = "v4.1_to_v4.0",
+  "5k_to_7k"  = "v4.0_to_v4.1",
+  "11k_to_7k" = "v5.0_to_v4.1",
+  "7k_to_11k" = "v4.1_to_v5.0"
+)
+
+map_ver2k <- c(V3 = "112k", v3 = "1129", v3.0 = "1129",
+               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)
+  bridge <- .bridge_map[bridge]
+  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 ( 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
+    )
+  }
+  if ( isFALSE(x == from) ) {
+    stop(
+      "You have indicated a bridge from ", .value(from),
+      " space, however your RFU data appears to be in version ",
+      .value(x), " space.", call. = FALSE
+    )
+  }
+
+  invisible(to)
+}