factor out function to check validity of index/identifier

Author: HelenaLC

R/CTutils.R

@@ -77,15 +77,7 @@ setMethod("CTlist", "SpatialDataAttrs", \(x, ...) {
 #' @rdname CTutils
 #' @export
 setMethod("CTdata", "SpatialDataAttrs", \(x, i=1, ...) {
-    stopifnot(length(i) == 1)
-    if (is.character(i)) {
-        match.arg(i, CTname(x))
-        i <- match(i, CTname(x))
-    } else if (is.numeric(i)) {
-        stopifnot(
-            i == round(i), 
-            i %in% seq_along(CTlist(x)))
-    } else stop("Invalid 'i'; should be a scalar character or integer")
+    i <- .resolve_id(i, CTname(x))
     t <- CTtype(x)[i]
     if (t != "sequence") 
         return(CTlist(x)[[i]][[t]])

R/mask.R

@@ -56,16 +56,7 @@ setMethod("mask", c("SpatialData", "ANY", "ANY"), \(x, i, j, k,
     if (!length(ct)) stop(
         "can't mask; found no common ",
         "coordinates between 'i' and 'j'")
-    if (missing(k)) {
-        k <- 1
-    } else {
-        if (is.character(k)) {
-            k <- match.arg(k, ct)
-            k <- match(k, ct)
-        } else if (is.numeric(k)) {
-            stopifnot(k > 0, k <= length(ct))
-        }
-    }
+    k <- if (missing(k)) 1 else .resolve_id(k, ct)
     .i <- transform(.i, ct[k])
     .j <- transform(.j, ct[k])
     t <- tryCatch(error=\(.) NULL, getTable(x, i))

R/read.R

@@ -136,15 +136,13 @@ readSpatialData <- function(x,
 
     # helper for layer reading
     .readLayer <- \(l) {
+        # 'j' are the paths on disk, 'nms' are their basenames
         j <- list.dirs(file.path(x, l), recursive=FALSE, full.names=TRUE)
-        names(j) <- basename(j)
+        nms <- names(j) <- basename(j)
         opt <- args[[l]]
         if (!isTRUE(opt)) {
-            if (is.numeric(opt) && opt > (. <- length(j)))
-                stop("'", l, "=", opt, "', but only ", ., " elements found")
-            if (is.character(opt) && length(. <- setdiff(opt, basename(j))))
-                stop("couldn't find ", l, " of name", .)
-            j <- j[opt]
+            # validate each requested element
+            j <- j[vapply(opt, .resolve_id, integer(1), ok=nms, nm=l)]
         }
         f <- paste0("read", toupper(substr(l, 1, 1)), substr(l, 2, nchar(l)-1))
         lapply(j, f)

R/trans.R

@@ -52,13 +52,7 @@ NULL
 #' @rdname trans
 #' @importFrom BiocGenerics transform
 setMethod("transform", "SpatialDataElement", \(x, i=1, ...) {
-    stopifnot(
-        length(i) == 1, is.character(i) | 
-        (is.numeric(i) && i == round(i)))
-    if (is.character(i)) {
-        i <- match.arg(i, CTname(x))
-        i <- match(i, CTname(x))
-    }
+    i <- .resolve_id(i, CTname(x))
     f <- CTtype(x)[i]
     t <- CTdata(x, i)
     if (f == "sequence") {

R/utils.R

@@ -10,6 +10,22 @@
     .GlobalEnv[[nm]]
 }
 
+# internal helper to resolve name/index to integer index
+.resolve_id <- \(i, ok, nm=deparse1(substitute(i))) {
+    nm <- sprintf("'%s'", nm)
+    if (is.character(i)) {
+        i <- match.arg(i, ok)
+        return(match(i, ok))
+    }
+    if (is.numeric(i) && i == round(i) && length(i) == 1) {
+        if (i < 1 || i > length(ok)) {
+            stop(sprintf("invalid %s index: %d (max: %d)", nm, i, length(ok)))
+        }
+        return(as.integer(i))
+    }
+    stop(sprintf("invalid %s; expected character or integer index", nm))
+}
+
 # internal helper for null-coalescing
 `%||%` <- \(a, b) if (is.null(a)) b else a