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/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,35 @@
 #' 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)
 
   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 +87,36 @@ 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 SomaScan assay version signal space
+  # prefer SignalSpace if present; NULL if absent
+  from_space <- atts$SignalSpace %||% getSomaScanVersion(adat)
+  checkSomaScanVersion(from_space)
+  from_space <-  switch(from_space,
+                        V4 =, v4 =, v4.0 = "5k",
+                        v4.1 =, v4 =, V4 = "7k",
+                        v5.0 =, v5 =, V5 = "11k")
+  new_space <- gsub("(.*)_to_(.*)$", "\\2", bridge)
+  .check_direction(from_space, new_space)   # this needs work
 
-  # 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)
+  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/utils-lift.R

@@ -0,0 +1,74 @@
+
+
+
+
+# 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"
+)
+
+# 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]])
+}
+
+# data: somascan data, as a `soma_adat` object
+.lift_plasma_to_v4.0 <- function(data) {
+  scaleAnalytes(data, .get_lift_ref("plasma"))
+}
+
+.lift_plasma_to_v4.1 <- function(data) {
+  scaleAnalytes(data, .get_lift_ref("plasma", "v4.0_to_v4.1"))
+}
+
+.lift_serum_to_v4.0 <- function(data) {
+  scaleAnalytes(data, .get_lift_ref("serum"))
+}
+
+.lift_serum_to_v4.1 <- function(data) {
+  scaleAnalytes(data, .get_lift_ref("serum", "v4.0_to_v4.1"))
+}
+
+
+# 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 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)
+}