Rearrange to desired signature, adjust tests

Author: MichaelChirico

R/expect-shape.R

@@ -1,76 +1,54 @@
 #' Does code return an object with the specified shape?
 #'
-#' By "shape", we mean an object's [dim()], or, for one-dimensional objects,
-#'   it's [length()]. Thus this is an extension of [expect_length()] to more
-#'   general objects like [data.frame()], [matrix()], and [array()].
-#' To wit, first, the object's `dim()` is checked. If non-`NULL`, it is compared
-#'   to `shape` (or one/both of `nrow`, `ncol`, if they are supplied, in which
-#'   case they take precedence). If `dim(object)` is `NULL`, `length(object)`
-#'   is compared to `shape`.
-#'
 #' @seealso [expect_length()] to specifically make assertions about the
 #'   [length()] of a vector.
 #' @inheritParams expect_that
-#' @param shape Expected shape, a numeric vector.
-#' @param nrow Expected number of rows, numeric.
-#' @param ncol Expected number of columns, numeric.
+#' @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, shape, nrow, ncol) {
-  stopifnot(
-    missing(shape) || is.numeric(shape),
-    missing(nrow) || is.numeric(nrow),
-    missing(ncol) || is.numeric(ncol)
-  )
+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."
+    )
+  }
 
-  dim_object <- dim(object)
-  if (is.null(dim_object)) {
-    if (missing(shape)) {
-      stop("`shape` must be provided for one-dimensional inputs")
-    }
-    return(expect_length(object, shape))
+  # 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) && missing(ncol)) {
-    # testing dim
-    if (missing(shape)) {
-      stop("`shape` must be provided if `nrow` and `ncol` are not")
-    }
-    act$shape <- dim_object
+  if (!missing(nrow)) {
+    act$nrow <- dim_object[1L]
 
     expect(
-      isTRUE(all.equal(act$shape, shape)),
-      sprintf("%s has shape (%s), not (%s).", act$lab, toString(act$shape), toString(shape))
+      act$nrow == nrow,
+      sprintf("%s has %i rows, not %i.", act$lab, act$nrow, nrow)
     )
-  } else if (missing(nrow) && !missing(ncol)) {
-    # testing only ncol
+  } 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 if (!missing(nrow) && missing(ncol)) {
-    # testing only nrow
-    act$nrow <- dim_object[1L]
+  } else { # !missing(dim)
+    act$dim <- dim_object
 
     expect(
-      act$nrow == nrow,
-      sprintf("%s has %i rows, not %i.", act$lab, act$nrow, nrow)
-    )
-  } else { # !missing(nrow) && !missing(ncol)
-    # testing both nrow & ncol (useful, e.g., for testing dim(.)[1:2] for arrays
-    act$nrow <- dim_object[1L]
-    act$ncol <- dim_object[2L]
-
-    expect(
-      act$nrow == nrow && act$ncol == ncol,
-      sprintf("%s has %i rows and %i columns, not %i rows and %i columns", act$lab, act$nrow, act$ncol, nrow, ncol)
+      isTRUE(all.equal(act$dim, dim)),
+      sprintf("%s has shape (%s), not (%s).", act$lab, toString(act$dim), toString(dim))
     )
   }
-
-  return(act$val)
 }

tests/testthat/test-expect-shape.R

@@ -1,16 +1,16 @@
 test_that("shape computed correctly", {
   # equivalent to expect_length
-  expect_success(expect_shape(1, 1))
-  expect_failure(expect_shape(1, 2), "has length 1, not length 2.")
-  expect_success(expect_shape(1:10, 10))
-  expect_success(expect_shape(letters[1:5], 5))
+  expect_success(expect_shape(1, length = 1))
+  expect_failure(expect_shape(1, length = 2), "has length 1, not 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), c(5L, 4L)))
-  expect_failure(expect_shape(matrix(nrow = 6, ncol = 3), c(6L, 2L)))
-  expect_failure(expect_shape(matrix(nrow = 6, ncol = 3), c(7L, 3L)))
-  expect_success(expect_shape(data.frame(1:10, 11:20), c(10, 2)))
-  expect_success(expect_shape(array(dim = 1:3), 1:3))
+  expect_success(expect_shape(matrix(nrow = 5, ncol = 4), dim = c(5L, 4L)))
+  expect_failure(expect_shape(matrix(nrow = 6, ncol = 3), dim = c(6L, 2L)))
+  expect_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))
@@ -21,31 +21,23 @@ test_that("shape computed correctly", {
   expect_success(expect_shape(matrix(nrow = 5, ncol = 4), ncol = 4L))
   expect_failure(expect_shape(matrix(nrow = 5, ncol = 5), ncol = 7L))
   expect_success(expect_shape(data.frame(1:10, 11:20), ncol = 2L))
-
-  # testing nrow= and ncol=
-  expect_success(expect_shape(matrix(nrow = 5, ncol = 4), nrow = 5L, ncol = 4L))
-  expect_failure(expect_shape(matrix(nrow = 5, ncol = 5), nrow = 6L, ncol = 5L))
-  expect_success(expect_shape(data.frame(1:10, 11:20), nrow = 10L, ncol = 2L))
-  expect_success(expect_shape(array(dim = 5:7), nrow = 5L, ncol = 6L))
-
-  # precedence of manual nrow/ncol over shape
-  expect_success(expect_shape(matrix(nrow = 7, ncol = 10), 1:2, nrow = 7L))
-  expect_success(expect_shape(matrix(nrow = 7, ncol = 10), 1:2, ncol = 10L))
 })
 
 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), 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, 2)
+  out <- expect_shape(x, length = 2)
   expect_identical(out, x)
 })
 
 test_that("at least one argument is required", {
-  expect_error(expect_shape(1:10), "`shape` must be provided for one-dimensional inputs", fixed = TRUE)
-  expect_error(expect_shape(cbind(1:2)), "`shape` must be provided if `nrow` and `ncol` are not")
+  err_msg <- "Exactly one of `length`, `nrow`, `ncol`, or `dim` must be provided."
+  expect_error(expect_shape(1:10), err_msg, fixed = TRUE) # no args
+  expect_error(expect_shape(1:10, 2), err_msg, fixed = TRUE) # no named args
+  expect_error(expect_shape(1:10, nrow = 1L, ncol = 2L), err_msg, fixed = TRUE) # multiple named args
 })