Add new SomaScan version functionality

NAMESPACE

@@ -65,6 +65,7 @@ export(anti_join)
 export(antilog)
 export(apt2seqid)
 export(arrange)
+export(checkSomaScanVersion)
 export(cleanNames)
 export(col2rn)
 export(collapseAdats)
@@ -80,6 +81,7 @@ export(getFeatures)
 export(getMeta)
 export(getSeqId)
 export(getSeqIdMatches)
+export(getSomaScanVersion)
 export(getSomamerData)
 export(getSomamers)
 export(getTargetNames)

R/adat-helpers.R

@@ -0,0 +1,101 @@
+#' Helpers to Extract Information from an ADAT
+#'
+#' [getAdatVersion()] determines the the ADAT version
+#'   number from a parsed ADAT header.\cr\cr
+#' [getSomaScanVersion()] determines the version of
+#'   SomaScan assay that a `soma_adat` object was run on.
+#'   These are elements of the `HEADER` attributes of the object.\cr\cr
+#' [checkSomaScanVersion()] determines if the version of
+#'   is a recognized version of SomaScan.\cr
+#' \cr
+#' Table of current SomaScan Assay versions:
+#' \tabular{lll}{
+#'   **Version**  \tab **Name** \tab **Size** \cr
+#'   `V4`         \tab 5k       \tab 5284     \cr
+#'   `v4.1`       \tab 7k       \tab 7596     \cr
+#'   `v5.0`       \tab 11k      \tab 11083    \cr
+#' }
+#'
+#' @name adat-helpers
+#' @param atts The *attributes* of a `soma_adat` object.
+#' @return Either a character string of length 1, or `NULL`.
+#'   \item{[getAdatVersion()]}{The key-value of the `Version` as a string.}
+#'   \item{[getSomaScanVersion()]}{The key-value of the `AssayVersion` as a string.}
+#'   \item{[checkSomaScanVersion()]}{Returns `NULL` (invisibly) if checks pass.}
+#' @author Stu Field
+#' @examples
+#' atts <- attributes(example_data)
+#' getAdatVersion(atts)
+#'
+#' atts$Header.Meta$HEADER$Version <- "1.0"
+#' getAdatVersion(atts)
+#' @export
+getAdatVersion <- function(atts) {
+
+  x <- atts$Header.Meta$HEADER
+  vidx <- grep("^Version$|^AdatVersion$", names(x))
+
+  if ( length(vidx) == 0L ) {
+    stop(
+      "Unable to identify ADAT Version from Header information. ",
+      "Please check 'Header.Meta'.", call. = FALSE
+    )
+  }
+
+  version <- as.character(x[[vidx]])
+
+  if ( length(version) > 1L ) {
+    warning(
+      "Version length > 1 ... there may be empty tabs in ",
+      "the header block above the data matrix.", call. = FALSE
+    )
+    version <- version[1L]
+  }
+
+  if ( identical(version, "1.01") ) {
+    stop(
+      "Invalid Version (", .value("1.01"), "). Please modify to `1.0.1`.",
+      call. = FALSE
+    )
+  }
+  version
+}
+
+
+.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
+#' @inheritParams params
+#' @examples
+#'
+#' ver <- getSomaScanVersion(example_data)
+#' ver
+#' @export
+getSomaScanVersion <- function(adat) {
+  as.character(attr(adat, "Header.Meta")$HEADER$AssayVersion)
+}
+
+
+#' Checks the SomaScan version
+#'
+#' @rdname adat-helpers
+#' @param ver `character(1)`. The SomaScan version as a string.
+#' @note The `"v"` is case insensitive.
+#' @examples
+#'
+#' is.null(checkSomaScanVersion(ver))
+#' @export
+checkSomaScanVersion <- function(ver) {
+  allowed <- c("v3.0", "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)
+  }
+  invisible(NULL)
+}

R/getAnalyteInfo.R

@@ -9,10 +9,9 @@
 #' (e.g. `seq.XXXX.XX`) become the `AptName` column of the lookup table and
 #' represents the key index between the table and `soma_adat` from which it comes.
 #'
-#' @param adat A `soma_adat` object (with intact attributes),
-#'   typically created using [read_adat()].
+#' @inheritParams params
 #' @return A `tibble` object with columns corresponding
-#' to the column meta data entries in the `soma_adat`. One row per analyte.
+#'   to the column meta data entries in the `soma_adat`. One row per analyte.
 #' @author Stu Field
 #' @seealso [getAnalytes()], [is_intact_attr()], [read_adat()]
 #' @examples

R/params.R

@@ -0,0 +1,15 @@
+#' Common Parameters in \pkg{SomaReadr}
+#'
+#' The parameters below are commonly used throughout
+#'   the \pkg{SomaReadr} package.
+#'
+#' @name params
+#'
+#' @param adat A `soma_adat` object (with intact attributes),
+#'   typically created using [read_adat()].
+#'
+#' @param x A `soma_adat` object (with intact attributes),
+#'   typically created using [read_adat()].
+#'
+#' @return A `soma_adat` class object.
+NULL

R/parseHeader.R

@@ -131,7 +131,7 @@ parseHeader <- function(file) {
   }
 
   # TRUE if old adat version
-  ret$file_specs$old_adat <- getAdatVersion(ret$Header.Meta) < "1.0.0"
+  ret$file_specs$old_adat <- getAdatVersion(ret) < "1.0.0"
   ret
 }
 

R/s3-print-soma-adat.R

@@ -23,10 +23,13 @@ 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)])
   n_apts <- getAnalytes(x, n = TRUE)
   pad    <- strrep(" ", 5L)
-  dim_vars <- c("Attributes intact", "Rows", "Columns", "Clinical Data", "Features")
-  dim_vals <- c(col_f(atts_symbol), nrow(x), ncol(x), length(meta), n_apts)
+  dim_vars <- c("SomaScan version", "Attributes intact", "Rows",
+                "Columns", "Clinical Data", "Features")
+  dim_vals <- c(ver, 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")

R/s3-soma-adat.R

@@ -62,7 +62,7 @@ NULL
     return(addClass(.data, "soma_adat"))
   }
 
-  if ( !is_intact_attr(x) || (length(j) == 1L && j > 0 )) {
+  if ( !is_intact_attr(x) || (length(j) == 1L && j > 0 ) ) {
     # if 1) attributes already broken OR
     #    2) extracting a single column
     #       this behavior may change to match `tbl_df` class

R/write-adat.R

@@ -21,8 +21,7 @@
 #' }
 #'
 #' @family IO
-#' @param x An object of class `soma_adat`.
-#'   Both [is.soma_adat()] and [is_intact_attr()] must be `TRUE`.
+#' @inheritParams params
 #' @param file Character. File path where the object should be written.
 #'   For example, extensions should be `*.adat`.
 #' @return Invisibly returns the input `x`.
@@ -146,7 +145,6 @@ write_adat <- function(x, file) {
 
 
 # Check ADAT prior to Writing
-# @param adat A `soma_adat` class object.
 .checkADAT <- function(adat) {
   atts <- attributes(adat)
   apts <- getAnalytes(adat)