omit ifelse

DESCRIPTION

@@ -51,7 +51,7 @@ Suggests:
     EBImage,
     knitr,
     Rgraphviz,
-    testthat
+    testthat (>= 3.0.0)
 biocViews: 
     DataImport, 
     DataRepresentation, 
@@ -67,3 +67,4 @@ VignetteBuilder: knitr
 BugReports: https://github.com/HelenaLC/spatialdataR/issues
 URL: https://helenalc.github.io/spatialdataR, https://github.com/HelenaLC/spatialdataR
 Config/roxygen2/version: 8.0.0
+Config/testthat/edition: 3

R/methods.R

@@ -375,7 +375,7 @@ f <- \(e) setReplaceMethod(e,
     \(x, i, ..., value) { 
         nms <- get(paste0(e, "Names"))(x)
         n <- length(get(paste0(e, "s"))(x))
-        i <- ifelse(i > n, paste0(e, n+1), nms[i])
+        i <- if (i > n) paste0(e, n+1) else nms[i]
         set <- get(paste0(e, "<-"))
         set(x, i, value=value)
     })

R/misc.R

@@ -54,7 +54,7 @@ NULL
     cat(sprintf("  - %s (%s)\n", p, d), sep="")
     # shapes
     nc <- vapply(shapes(object), ncol, numeric(1))
-    geom <- ifelse(nc == 1, "polygon", "circle")
+    geom <- c("circle", "polygon")[(nc == 1) + 1L]
     d <- vapply(shapes(object), nrow, numeric(1))
     d <- paste(d, unname(geom), sep=",")
     cat(sprintf("- shapes(%s):\n", length(s)))
@@ -88,8 +88,8 @@ setMethod("show", "SpatialData", .showSpatialData)
 
 #' @importFrom S4Vectors coolcat
 .showArray <- function(object) {
-    n.object <- length(object@data)
-    cat("class: ", class(object), ifelse(n.object > 1, "(MultiScale)", ""),"\n")
+    n <- length(object@data)
+    cat("class:", class(object), if (n > 1) "(MultiScale)" else "", "\n")
     scales <- vapply(object@data, \(x) paste0(dim(x), collapse=","), character(1))
     coolcat("Scales (%d): (%s)", scales)
 }
@@ -132,12 +132,12 @@ setMethod("show", "SpatialDataShape", .showShape)
     # coordinate transformations
     CTshow <- \(l) {
         f <- \(.) {
-            . <- paste(unlist(.), collapse=",")
-            ifelse(grepl(",", .), sprintf("[%s]", .), .)
+            if (length(.) <= 1) return(.)
+            sprintf("[%s]", paste(unlist(.), collapse=","))
         }
         g <- \(.) {
-            na <- is.null(.) || !length(unlist(.))
-            ifelse(na, "", paste0(":", f(lapply(., f))))
+            na <- !length(unlist(.))
+            if (na) "" else paste0(":", f(lapply(., f)))
         }
         h <- \(.) sprintf("(%s%s)", .$type, g(.[[.$type]]))
         if (l$type == "sequence") {

R/sdFrame.R

@@ -103,13 +103,14 @@ NULL
 #' @importFrom duckspatial as_duckspatial_df
 .duck <- \(data, name) {
     # silent complaint re: missing CRS
-    suppressMessages( 
+    suppressWarnings(suppressMessages(
         ddbs_write_table(
             conn=.conn(),
             data=data,
             name=name,
             overwrite=TRUE,
-            temp_view=FALSE))
+            temp_view=FALSE)
+    ))    
     as_duckspatial_df(
         x=name, 
         conn=.conn(), 
@@ -122,7 +123,6 @@ NULL
 #' @importFrom methods is
 #' @importFrom sf st_geometry_type
 #' @importFrom S4Vectors metadata<-
-#' @importFrom duckspatial as_duckspatial_df
 SpatialDataPoint <- \(data=NULL, meta=SpatialDataAttrs(type="frame"), metadata=list(), ik=NULL, fk=NULL, ...) {
     data <- .df_to_sf(data, "POINT")
     if (isTRUE(nrow(data) > 0L)) {

tests/testthat.R

@@ -1,2 +1,4 @@
 library(testthat)
+library(spatialdataR)
+
 test_check("spatialdataR")

tests/testthat/_snaps/methods.md

@@ -0,0 +1,28 @@
+# show
+
+    Code
+      show(x)
+    Output
+      class: SpatialData
+      - images(2):
+        - blobs_image (3,64,64)
+        - blobs_multiscale_image (3,64,64)
+      - labels(2):
+        - blobs_labels (64,64)
+        - blobs_multiscale_labels (64,64)
+      - points(1):
+        - blobs_points (200)
+      - shapes(3):
+        - blobs_circles (5,circle)
+        - blobs_multipolygons (2,polygon)
+        - blobs_polygons (5,polygon)
+      - tables(1):
+        - table (3,10) [blobs_labels]
+      coordinate systems(5):
+      - global(8): blobs_image blobs_multiscale_image ... blobs_polygons
+        blobs_points
+      - scale(1): blobs_labels
+      - translation(1): blobs_labels
+      - affine(1): blobs_labels
+      - sequence(1): blobs_labels
+

tests/testthat/test-crop.R

@@ -8,7 +8,11 @@ x <- readSpatialData(x)
 test_that("crop,SpatialData", {
     # all-inclusive crop
     y <- list(xmin=-100, xmax=100, ymin=-100, ymax=100)
-    expect_equivalent(crop(x, y), x)
+    z <- crop(x, y)
+    for (e in unlist(colnames(z))) 
+        expect_identical(
+            dim(element(x, e)), 
+            dim(element(z, e)))
     # crop around single point
     xy <- st_coordinates(st_as_sf(data(point(x)[1])))
     bb <- list(
@@ -94,7 +98,7 @@ test_that("crop,sdLabel", {
 
 test_that("crop input 'y' .to_sf()", {
     ok <- \(x) {
-        expect_is(x, "sf")
+        expect_s3_class(x, "sf")
         expect_identical(names(x), "geometry")
         expect_no_error(SpatialDataShape(x))
         expect_equal(as.integer(st_bbox(x)), c(0,-1,2,1))
@@ -116,7 +120,7 @@ test_that("crop-box,sdPoint", {
     n <- length(p <- point(x))
     # this shouldn't do anything
     q <- crop(p, list(xmin=-1e7, xmax=1e7, ymin=-1e7, ymax=1e7))
-    expect_is(data(q), "duckspatial_df")
+    expect_s3_class(data(q), "duckspatial_df")
     expect_identical(collect(data(p)), collect(data(q)))
     # this should drop everything
     q <- crop(p, list(xmin=0, xmax=1e-3, ymin=0, ymax=1e-3))
@@ -154,7 +158,7 @@ test_that("crop-pol,sdShape", {
     n <- length(s <- shape(x))
     # mock all-inclusive crop
     xy <- rbind(c(0,0), c(0,1e6), c(1e6,0))
-    expect_equal(crop(s, xy), s, check.attributes = FALSE)
+    expect_identical(dim(crop(s, xy)), dim(crop(s, xy)))
 })
 
 test_that("crop,sdShape w/ table", {
@@ -175,7 +179,7 @@ test_that("crop,sdShape w/ table", {
     z <- crop(y, bb)
     expect_length(shape(z), 1)
     expect_equal(dim(table(z, "x")), c(0,1))
-    expect_equivalent(shape(z), shape(y)[.])
+    expect_identical(dim(shape(z)), dim(shape(y)[.]))
 })
 
 test_that(".box2rev works with real image and injected scale", {

tests/testthat/test-ctgraph.R

@@ -8,7 +8,7 @@ test_that("CTgraph", {
     expect_error(CTgraph(table(x)))
     # object-wide
     g <- CTgraph(x)
-    expect_is(g, "graph")
+    expect_s4_class(g, "graph")
     # graph should contain node for
     # every element & transformation
     ns <- lapply(setdiff(spatialdataR:::.LAYERS, "tables"), 
@@ -21,7 +21,7 @@ test_that("CTgraph", {
         for (e in names(x[[l]])) {
             y <- x[[l]][[e]]
             g <- CTgraph(y)
-            expect_is(g, "graph")
+            expect_s4_class(g, "graph")
             expect_true("_self" %in% graph::nodes(g))
         }
 })
@@ -31,10 +31,10 @@ test_that("CTpath", {
     y <- element(x, i)
     z <- CTpath(y, j <- CTname(y))
     expect_identical(CTpath(x, i, j), z)
-    expect_is(z, "list")
+    expect_type(z, "list")
     expect_length(z <- z[[1]], 2)
     expect_setequal(names(z), c("type", "data"))
-    expect_is(z$type, "character")
+    expect_type(z$type, "character")
     expect_length(z$type, 1)
 })
 
@@ -47,7 +47,7 @@ test_that("CTplot", {
     }
     g <- CTgraph(x)
     p <- f(CTplot(g))
-    expect_is(p, "numeric")
+    expect_type(p, "double")
     expect_true(p > f(plot(1)))
     p <- f(CTplot(g, 0.1))
     q <- f(CTplot(g, 0.9))

tests/testthat/test-ctutils.R

@@ -7,17 +7,17 @@ test_that("axes", {
     for (e in es) {
         z <- axes(e)
         d <- length(dim(e))
-        expect_is(z, "list")
+        expect_type(z, "list")
         expect_length(z, d)
         expect_error(axes(e, "bad"))
         # name
         expect_silent(z <- axes(e, "name"))
-        expect_is(z, "character")
+        expect_type(z, "character")
         expect_length(z, d)
         expect_in(z, c("t","c","z","y","x"))
         # type
         expect_silent(z <- axes(e, "type"))
-        expect_is(z, "character")
+        expect_type(z, "character")
         expect_length(z, d)
         expect_in(z, c("time","channel","space"))
     }
@@ -29,7 +29,7 @@ test_that("axes", {
 
 test_that("CTlist", {
     y <- CTlist(label(x))
-    expect_is(y, "list")
+    expect_type(y, "list")
     expect_length(y, 5)
     z <- Reduce(intersect, lapply(y, names))
     expect_setequal(z, c("input", "output", "type"))
@@ -47,51 +47,51 @@ test_that("CTdata", {
     expect_null(y)
     # scale
     y <- CTdata(label(x), "scale")
-    expect_is(y, "list")
+    expect_type(y, "list")
     expect_length(y, 2)
-    expect_is(unlist(y), "numeric")
+    expect_type(unlist(y), "double")
     expect_true(all(unlist(y) > 0))
     # translation
     y <- CTdata(label(x), "translation")
-    expect_is(y, "list")
+    expect_type(y, "list")
     expect_length(y, 2)
-    expect_is(unlist(y), "numeric")
+    expect_type(unlist(y), "double")
     # affine
     y <- CTdata(label(x), "affine")
-    expect_is(y, "list")
+    expect_type(y, "list")
     expect_length(y, 2)
-    expect_is(unlist(y), "numeric")
+    expect_type(unlist(y), "double")
     expect_true(all(unlist(y) > 0))
     z <- vapply(y, length, integer(1))
     expect_true(all(z == 3))
     # sequence
     y <- CTdata(label(x), "sequence")
-    expect_is(y, "list")
+    expect_type(y, "list")
     expect_length(y, 2)
     expect_true(all(names(y) %in% .CTtype))
     z <- vapply(y, length, integer(1))
     expect_true(all(z == 2))
 })
 test_that("CTtype", {
     y <- CTtype(label(x))
-    expect_is(y, "character")
+    expect_type(y, "character")
     expect_length(y, 5)
     expect_true(all(y %in% .CTtype))
 })
 test_that("CTname,element", {
     y <- CTname(label(x))
-    expect_is(y, "character")
+    expect_type(y, "character")
     expect_length(y, 5)
     expect_true(all(nchar(y) > 0))
     expect_true(!any(duplicated(y)))
 })
 test_that("CTname,object", {
     y <- CTname(x)
-    expect_is(y, "character")
+    expect_type(y, "character")
     expect_true(!any(duplicated(y)))
     y <- CTname(image(x))
     z <- CTname(meta(image(x)))
-    expect_is(y, "character")
+    expect_type(y, "character")
     expect_length(y, 1)
     expect_identical(y, z)
 })

tests/testthat/test-mask.R

@@ -43,9 +43,10 @@ test_that("mask,sdImage,sdLabel", {
     expect_identical(y, z)
 
     # check against original
-    expect_equivalent(
-        assay(tables(y)[[2]]), 
-        assay(tables(x)[[1]]))
+    y <- mask(x, i, j, how="sum")
+    expect_equal(
+        unname(assay(tables(x)[[1]])),
+        unname(assay(tables(y)[[2]])))
 
     # no matching scale
     .i <- image(x, "blobs_multiscale_image")