Use dedicated base R functions to simplify some code patterns

R/CTgraph.R

@@ -171,7 +171,7 @@ CTplot <- \(g, cex=0.5, fac=2, max=10) {
 }
 
 .fixup <- \(x, fac) {
-    xs <- strsplit(x, "")
+    xs <- strsplit(x, "", fixed = TRUE)
     nc <- floor(nchar(x)/fac)
     vapply(seq_along(xs), \(i) {
         j <- seq_len(nc[i])

R/Zattrs.R

@@ -58,7 +58,7 @@ setMethod("multiscales", "list", \(x) {
     cat(sprintf("coordTrans(%d):\n", n <- length(CTname(object))))
     g <- \(.) {
         . <- paste(unlist(.), collapse=",")
-        if (!grepl(",", .)) return(.)
+        if (!grepl(",", ., fixed = TRUE)) return(.)
         sprintf("[%s]", .)
     }
     f <- \(.) {

R/mask.R

@@ -104,10 +104,10 @@ setMethod(".mask", c("PointFrame", "ShapeFrame"), \(i, j, how=NULL, ...) {
     if (!is.null(how)) warning("Can only count when masking points; ignoring 'how'")
     fun <- switch(geom_type(j),
         POINT=\(i, j) rowSums(st_distance(j, i) <= j$radius),
-        \(i, j) vapply(st_intersects(j, i), length, integer(1)))
+        \(i, j) lengths(st_intersects(j, i)))
     # realize one feature at i time
     n <- nrow(j <- st_as_sf(data(j)))
-    is <- split(seq_len(length(i)), i[[feature_key(i)]])
+    is <- split(seq_along(i), i[[feature_key(i)]])
     ns <- lapply(is, \(.) {
         # make points 'sf'-compliant
         i <- as.data.frame(i[., c("x", "y")])
@@ -121,7 +121,7 @@ setMethod(".mask", c("PointFrame", "ShapeFrame"), \(i, j, how=NULL, ...) {
     # collect into matrix w/ dim. features x shapes
     ns <- t(do.call(cbind, ns))
     rownames(ns) <- names(is)
-    colnames(ns) <- seq(ncol(ns))
+    colnames(ns) <- seq_len(ncol(ns))
     SingleCellExperiment(list(counts=ns))
 })
 
@@ -144,7 +144,7 @@ setMethod(".mask", c("ShapeFrame", "ShapeFrame"), \(i, j, how=NULL, table=NULL,
     ns <- tabulate(is, ni <- nlevels(is))
     # aggregation
     mx <- assay(table, assay)
-    if (grepl("detected$", how)) mx <- mx > 0
+    if (endsWith(how, "detected")) mx <- mx > 0
     my <- sparseMatrix(
         x=rep(1, length(is)), 
         i=seq_along(is), j=is, 

R/methods.R

@@ -25,15 +25,15 @@ setMethod("[[", c("SpatialData", "character"), \(x, i, ...) {
 .sub_i <- \(x, i) {
     if (isTRUE(i)) return(x)
     if (is.numeric(i) || is.logical(i)) i <- rownames(x)[i]
-    if (any(is.na(i))) stop("invalid 'i'")
+    if (anyNA(i)) stop("invalid 'i'")
     for (. in setdiff(rownames(x), i)) attr(x, .) <- list()
     x
 }
 .sub_j <- \(x, j) {
     if (isTRUE(j)) return(x)
     # count number of elements in each layer,
     # and number of layers with any elements
-    nl <- sum((ne <- vapply(colnames(x), length, numeric(1))) > 0)
+    nl <- sum((ne <- lengths(colnames(x))) > 0)
     if (!is.list(j)) {
         if (nl == 1) j <- list(j)
         if (length(j) == 1) j <- as.list(rep(j, nl))

R/misc.R

@@ -44,33 +44,28 @@ NULL
     d <- lapply(images(object), dim)
     d <- lapply(d, paste, collapse=",")
     cat(sprintf("- images(%s):\n", length(i)))
-    for (. in seq_along(i)) 
-        cat(sprintf("  - %s (%s)\n", i[.], d[.]))
+    cat(sprintf("  - %s (%s)\n", i, d), sep="")
     # labels
     d <- lapply(labels(object), dim)
     d <- lapply(d, paste, collapse=",")
     cat(sprintf("- labels(%s):\n", length(l)))
-    for (. in seq_along(l)) 
-        cat(sprintf("  - %s (%s)\n", l[.], d[.]))
+    cat(sprintf("  - %s (%s)\n", l, d), sep="")
     # points
-    d <- lapply(points(object), length)
+    d <- lengths(points(object))
     cat(sprintf("- points(%s):\n", length(p)))
-    for (. in seq_along(p)) 
-        cat(sprintf("  - %s (%s)\n", p[.], d[.]))
+    cat(sprintf("  - %s (%s)\n", p, d), sep="")
     # shapes
     nc <- vapply(shapes(object), ncol, numeric(1))
     geom <- ifelse(nc == 1, "polygon", "circle")
     d <- vapply(shapes(object), nrow, numeric(1))
     d <- paste(d, unname(geom), sep=",")
     cat(sprintf("- shapes(%s):\n", length(s)))
-    for (. in seq_along(s)) 
-        cat(sprintf("  - %s (%s)\n", s[.], d[.]))
+    cat(sprintf("  - %s (%s)\n", s, d), sep="")
     # tables
     d <- lapply(tables(object), dim)
     d <- lapply(d, paste, collapse=",")
     cat(sprintf("- tables(%s):\n", length(t)))
-    for (. in seq_along(t)) 
-        cat(sprintf("  - %s (%s)\n", t[.], d[.]))
+    cat(sprintf("  - %s (%s)\n", t, d), sep="")
     # spaces
     e <- c(i, l, s, p)
     g <- CTgraph(object)
@@ -94,8 +89,8 @@ setMethod("show", "SpatialData", .showSpatialData)
 .showsdArray <- function(object) {
     n.object <- length(object@data)
     cat("class: ", class(object), ifelse(n.object > 1, "(MultiScale)", ""),"\n")
-    scales <- vapply(object@data, \(x) sprintf("(%s)", paste0(dim(x), collapse=",")), character(1))
-    coolcat("Scales (%d): %s", scales)
+    scales <- vapply(object@data, \(x) paste0(dim(x), collapse=","), character(1))
+    coolcat("Scales (%d): (%s)", scales)
 }
 
 #' @rdname misc

R/query.R

@@ -70,7 +70,7 @@ setMethod("query", "SpatialData", \(x, ..., i) {
         i <- match.arg(i, tableNames(x))
     }
     t <- x$tables[[i]]
-    ns <- vapply(nm <- colnames(x), length, integer(1))
+    ns <- lengths(nm <- colnames(x))
     nm <- data.frame(layer=rep.int(names(nm), ns), region=unlist(nm))
     nm <- filter(nm, ...)
     i <- match(nm$layer, .LAYERS)

R/validity.R

@@ -17,7 +17,7 @@
             ok <- all(vapply(md, is.character, logical(1)))
             if (!ok) msg <- c(msg, paste0(
                 i, "-th table's ", .nm, " is not of type character"))
-            ok <- all(vapply(intersect(md, nm[-1]), length, integer(1)) == 1)
+            ok <- all(lengths(intersect(md, nm[-1])) == 1)
             if (!ok) msg <- c(msg, paste0(
                 i, "-th table's 'region/instance_key' is not length 1"))
             ok <- !is.null(int_colData(se)[[md$region_key]])