Expect shape

NAMESPACE

@@ -119,6 +119,7 @@ export(expect_s3_class)
 export(expect_s4_class)
 export(expect_s7_class)
 export(expect_setequal)
+export(expect_shape)
 export(expect_silent)
 export(expect_snapshot)
 export(expect_snapshot_error)

NEWS.md

@@ -6,6 +6,7 @@
 * Fixed an issue preventing compilation from succeeding due to deprecation / removal of `std::uncaught_exception()` (@kevinushey, #2047).
 * New `skip_unless_r()` to skip running tests on unsuitable versions of R, e.g. `skip_unless_r(">= 4.1.0")` to skip tests that require, say, `...names` (@MichaelChirico, #2022)
 * `skip_on_os()` gains an option `"emscripten"` of the `os` argument to skip tests on Emscripten (@eitsupi, #2103).
+* New expectation, `expect_shape()`, for testing the shape (i.e., the `length()`, `nrow()`, `ncol()`, or `dim()`, all in one place (#1423, @michaelchirico).
 
 # testthat 3.2.3
 

R/expect-length.R

@@ -1,6 +1,7 @@
 #' Does code return a vector with the specified length?
 #'
-#' @seealso [expect_vector()] to make assertions about the "size" of a vector
+#' @seealso [expect_vector()] to make assertions about the "size" of a vector,
+#'   [expect_shape()] for more general assertions about object "shape".
 #' @inheritParams expect_that
 #' @param n Expected length.
 #' @family expectations

R/expect-shape.R

@@ -0,0 +1,57 @@
+#' Does code return an object with the specified shape?
+#'
+#' This is a generalization of [expect_length()] to test the "shape" of
+#'   more general objects like data.frames, matrices, and arrays.
+#'
+#' @seealso [expect_length()] to specifically make assertions about the
+#'   [length()] of a vector.
+#' @inheritParams expect_that
+#' @param ... Ignored.
+#' @param length Expected [length()] of `object`.
+#' @param nrow Expected [nrow()] of `object`.
+#' @param ncol Expected [ncol()] of `object`.
+#' @param dim Expected [dim()] of `object`.
+#' @family expectations
+#' @export
+#' @examples
+expect_shape = function(object, ..., length, nrow, ncol, dim) {
+  # absent, not present, due to '!' operator precedence
+  n_absent <- missing(length) + missing(nrow) + missing(ncol) + missing(dim)
+  if (n_absent != 3L) {
+    cli::cli_abort(
+      "Exactly one of {.arg length}, {.arg nrow}, {.arg ncol}, or {.arg dim} must be provided."
+    )
+  }
+
+  # Re-use expect_length() to ensure they stay in sync.
+  if (!missing(length)) {
+    return(expect_length(object, length))
+  }
+
+  act <- quasi_label(enquo(object), arg = "object")
+  # need base:: qualification or we might trigger an error for missing(dim)
+  dim_object <- base::dim(object)
+
+  if (!missing(nrow)) {
+    act$nrow <- dim_object[1L]
+
+    expect(
+      act$nrow == nrow,
+      sprintf("%s has %i rows, not %i.", act$lab, act$nrow, nrow)
+    )
+  } else if (!missing(ncol)) {
+    act$ncol <- dim_object[2L]
+
+    expect(
+      act$ncol == ncol,
+      sprintf("%s has %i columns, not %i.", act$lab, act$ncol, ncol)
+    )
+  } else { # !missing(dim)
+    act$dim <- dim_object
+
+    expect(
+      isTRUE(all.equal(act$dim, dim)),
+      sprintf("%s has shape (%s), not (%s).", act$lab, toString(act$dim), toString(dim))
+    )
+  }
+}

_pkgdown.yml

@@ -26,6 +26,7 @@ reference:
 - subtitle: Vectors
   contents:
   - expect_length
+  - expect_shape
   - expect_gt
   - expect_match
   - expect_named

tests/testthat/_snaps/expect-shape.md

@@ -0,0 +1,44 @@
+# shape computed correctly
+
+    `object` has length 1, not length 2.
+
+---
+
+    matrix(nrow = 6, ncol = 3) has shape (6, 3), not (6, 2).
+
+---
+
+    matrix(nrow = 6, ncol = 3) has shape (6, 3), not (7, 3).
+
+---
+
+    matrix(nrow = 5, ncol = 5) has 5 rows, not 6.
+
+---
+
+    matrix(nrow = 5, ncol = 5) has 5 columns, not 7.
+
+# at least one argument is required
+
+    Code
+      expect_shape(1:10)
+    Condition
+      Error in `expect_shape()`:
+      ! Exactly one of `length`, `nrow`, `ncol`, or `dim` must be provided.
+
+---
+
+    Code
+      expect_shape(1:10, 2)
+    Condition
+      Error in `expect_shape()`:
+      ! Exactly one of `length`, `nrow`, `ncol`, or `dim` must be provided.
+
+---
+
+    Code
+      expect_shape(1:10, nrow = 1L, ncol = 2L)
+    Condition
+      Error in `expect_shape()`:
+      ! Exactly one of `length`, `nrow`, `ncol`, or `dim` must be provided.
+

tests/testthat/test-expect-shape.R

@@ -0,0 +1,43 @@
+test_that("shape computed correctly", {
+  # equivalent to expect_length
+  expect_success(expect_shape(1, length = 1))
+  expect_snapshot_failure(expect_shape(1, length = 2))
+  expect_success(expect_shape(1:10, length = 10))
+  expect_success(expect_shape(letters[1:5], length = 5))
+
+  # testing dim()
+  expect_success(expect_shape(matrix(nrow = 5, ncol = 4), dim = c(5L, 4L)))
+  expect_snapshot_failure(expect_shape(matrix(nrow = 6, ncol = 3), dim = c(6L, 2L)))
+  expect_snapshot_failure(expect_shape(matrix(nrow = 6, ncol = 3), dim = c(7L, 3L)))
+  expect_success(expect_shape(data.frame(1:10, 11:20), dim = c(10, 2)))
+  expect_success(expect_shape(array(dim = 1:3), dim = 1:3))
+
+  # testing nrow=
+  expect_success(expect_shape(matrix(nrow = 5, ncol = 4), nrow = 5L))
+  expect_snapshot_failure(expect_shape(matrix(nrow = 5, ncol = 5), nrow = 6L))
+  expect_success(expect_shape(data.frame(1:10, 11:20), nrow = 10L))
+
+  # testing ncol=
+  expect_success(expect_shape(matrix(nrow = 5, ncol = 4), ncol = 4L))
+  expect_snapshot_failure(expect_shape(matrix(nrow = 5, ncol = 5), ncol = 7L))
+  expect_success(expect_shape(data.frame(1:10, 11:20), ncol = 2L))
+})
+
+test_that("uses S4 dim method", {
+  A <- setClass("ExpectShapeA", slots = c(x = "numeric", y = "numeric"))
+  setMethod("dim", "ExpectShapeA", function(x) 8:10)
+  expect_success(expect_shape(A(x = 1:9, y = 3), dim = 8:10))
+})
+
+test_that("returns input", {
+  x <- list(1:10, letters)
+  out <- expect_shape(x, length = 2)
+  expect_identical(out, x)
+})
+
+test_that("at least one argument is required", {
+  err_msg <- "Exactly one of `length`, `nrow`, `ncol`, or `dim` must be provided."
+  expect_snapshot(expect_shape(1:10), error = TRUE) # no args
+  expect_snapshot(expect_shape(1:10, 2), error = TRUE) # no named args
+  expect_snapshot(expect_shape(1:10, nrow = 1L, ncol = 2L), error = TRUE) # multiple named args
+})