diff --git a/R/CTgraph.R b/R/CTgraph.R index a1a2dd40..00723079 100644 --- a/R/CTgraph.R +++ b/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]) diff --git a/R/Zattrs.R b/R/Zattrs.R index eb969bec..7c59cc43 100644 --- a/R/Zattrs.R +++ b/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 <- \(.) { diff --git a/R/mask.R b/R/mask.R index 6b81b514..34a08b87 100644 --- a/R/mask.R +++ b/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, diff --git a/R/methods.R b/R/methods.R index ed30acf8..47821e00 100644 --- a/R/methods.R +++ b/R/methods.R @@ -25,7 +25,7 @@ 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 } @@ -33,7 +33,7 @@ setMethod("[[", c("SpatialData", "character"), \(x, i, ...) { 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)) diff --git a/R/misc.R b/R/misc.R index 713a5b82..79bd2891 100644 --- a/R/misc.R +++ b/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 diff --git a/R/query.R b/R/query.R index 01fa1524..616c7a73 100644 --- a/R/query.R +++ b/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) diff --git a/R/validity.R b/R/validity.R index f30ed209..772584c5 100644 --- a/R/validity.R +++ b/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]])