Allow to check the number of rows/columns

DESCRIPTION

@@ -33,11 +33,11 @@ RoxygenNote: 7.3.2
 Collate: 
     'AllGenerics.R'
     'append.R'
+    'predicates.R'
+    'assert.R'
     'arkhe-deprecated.R'
     'arkhe-internal.R'
     'arkhe-package.R'
-    'predicates.R'
-    'assert.R'
     'assign.R'
     'clean.R'
     'compact.R'

NAMESPACE

@@ -6,6 +6,7 @@ export(assert_colnames)
 export(assert_constant)
 export(assert_count)
 export(assert_decreasing)
+export(assert_dim)
 export(assert_dimensions)
 export(assert_empty)
 export(assert_even)
@@ -19,7 +20,9 @@ export(assert_lengths)
 export(assert_lower)
 export(assert_missing)
 export(assert_names)
+export(assert_ncol)
 export(assert_negative)
+export(assert_nrow)
 export(assert_odd)
 export(assert_package)
 export(assert_positive)

NEWS.md

@@ -1,4 +1,7 @@
 # arkhe 1.7.0.9000
+## New classes and methods
+* Add `assert_nrow` and `assert_ncol` to check the number of rows/columns.
+
 ## Enhancements
 * `seek_rows()` and `seek_columns()` gained a new `names` argument.
 * `assert_type()` gained new `allow_empty` and `allow_null` arguments.

R/arkhe-deprecated.R

@@ -1,6 +1,14 @@
+# DATA CLEANING: APPEND
+#' @include assert.R
+NULL
+
 #' Deprecated Functions in arkhe
 #'
 #' These functions still work but will be removed (defunct) in the next version.
 #' @name arkhe-deprecated
 #' @keywords internal
 NULL
+
+#' @export
+#' @rdname arkhe-deprecated
+assert_dimensions <- assert_dim

R/assert.R

@@ -72,19 +72,21 @@ assert_package <- function(x, ask = TRUE) {
 needs <- assert_package
 
 # Attributes ===================================================================
-#' Check Object Length/Dimensions
+#' Check Object Length(s)
 #'
 #' @param x An object to be checked.
 #' @param expected An appropriate expected value.
-#' @param empty A [`logical`] scalar: should empty objects be ignored?
+#' @param allow_empty A [`logical`] scalar: should [empty][is_empty()] object be
+#'  allowed?
+#' @param empty Deprecated.
 #' @return
 #'  Throws an error, if any, and returns `x` invisibly otherwise.
 #' @author N. Frerebeau
 #' @family checking methods
 #' @export
-assert_length <- function(x, expected, empty = FALSE) {
+assert_length <- function(x, expected, allow_empty = empty, empty = FALSE) {
   arg <- deparse(substitute(x))
-  if (!(empty & is_empty(x)) && !has_length(x, n = expected)) {
+  if (!(allow_empty && is_empty(x)) && !has_length(x, n = expected)) {
     msg <- sprintf("%s must be of length %d; not %d.", sQuote(arg),
                    expected, length(x))
     throw_error("error_bad_length", msg)
@@ -97,7 +99,7 @@ assert_length <- function(x, expected, empty = FALSE) {
 assert_lengths <- function(x, expected) {
   arg <- deparse(substitute(x))
   n <- lengths(x)
-  if (any(n != expected)) {
+  if (!all(n == expected)) {
     msg <- sprintf("Elements of %s must be of lengths %s; not %s.", sQuote(arg),
                    paste0(expected, collapse = ", "),
                    paste0(n, collapse = ", "))
@@ -106,37 +108,79 @@ assert_lengths <- function(x, expected) {
   invisible(x)
 }
 
+#' Check Object Dimensions
+#'
+#' @param x An object to be checked.
+#' @param expected An appropriate expected value.
+#' @return
+#'  Throws an error, if any, and returns `x` invisibly otherwise.
+#' @author N. Frerebeau
+#' @family checking methods
 #' @export
-#' @rdname assert_length
-assert_empty <- function(x) {
+assert_dim <- function(x, expected) {
   arg <- deparse(substitute(x))
-  if (!is_empty(x)) {
-    msg <- sprintf("%s must be empty.", sQuote(arg))
+  n <- dim(x)
+  if (!all(n == expected)) {
+    msg <- sprintf("%s must be of dimension %s; not %s.", sQuote(arg),
+                   paste0(expected, collapse = " x "),
+                   paste0(n, collapse = " x "))
     throw_error("error_bad_dimensions", msg)
   }
   invisible(x)
 }
 
 #' @export
-#' @rdname assert_length
-assert_filled <- function(x) {
+#' @rdname assert_dim
+assert_nrow <- function(x, expected) {
   arg <- deparse(substitute(x))
-  if (is_empty(x)) {
-    msg <- sprintf("%s must not be empty.", sQuote(arg))
+  n <- nrow(x)
+  if (n != expected) {
+    txt <- ngettext(expected, "%s must have %s row; not %s.",
+                    "%s must have %s rows; not %s.")
+    msg <- sprintf(txt, sQuote(arg), expected, n)
     throw_error("error_bad_dimensions", msg)
   }
   invisible(x)
 }
 
 #' @export
-#' @rdname assert_length
-assert_dimensions <- function(x, expected) {
+#' @rdname assert_dim
+assert_ncol <- function(x, expected) {
   arg <- deparse(substitute(x))
-  n <- dim(x)
-  if (any(n != expected)) {
-    msg <- sprintf("%s must be of dimension %s; not %s.", sQuote(arg),
-                   paste0(expected, collapse = " x "),
-                   paste0(n, collapse = " x "))
+  n <- ncol(x)
+  if (n != expected) {
+    txt <- ngettext(expected, "%s must have %s column; not %s.",
+                    "%s must have %s columns; not %s.")
+    msg <- sprintf(txt, sQuote(arg), expected, n)
+    throw_error("error_bad_dimensions", msg)
+  }
+  invisible(x)
+}
+
+#' Check Object Filling
+#'
+#' Checks if an object is (not) empty.
+#' @param x An object to be checked.
+#' @return
+#'  Throws an error, if any, and returns `x` invisibly otherwise.
+#' @author N. Frerebeau
+#' @family checking methods
+#' @export
+assert_empty <- function(x) {
+  arg <- deparse(substitute(x))
+  if (!is_empty(x)) {
+    msg <- sprintf("%s must be empty.", sQuote(arg))
+    throw_error("error_bad_dimensions", msg)
+  }
+  invisible(x)
+}
+
+#' @export
+#' @rdname assert_empty
+assert_filled <- function(x) {
+  arg <- deparse(substitute(x))
+  if (is_empty(x)) {
+    msg <- sprintf("%s must not be empty.", sQuote(arg))
     throw_error("error_bad_dimensions", msg)
   }
   invisible(x)

inst/tinytest/test_assert.R

@@ -40,14 +40,14 @@ expect_identical(assert_function(mean), mean)
 
 # Assert object attributes =====================================================
 ## Length ----------------------------------------------------------------------
-cnd <- arkhe:::catch_conditions(assert_length(LETTERS, expected = 10, empty = FALSE))
+cnd <- arkhe:::catch_conditions(assert_length(LETTERS, expected = 10))
 expect_inherits(cnd[[1]], "error_bad_length")
-cnd <- arkhe:::catch_conditions(assert_length(LETTERS, expected = 10, empty = TRUE))
+cnd <- arkhe:::catch_conditions(assert_length(LETTERS, expected = 10, allow_empty = TRUE))
 expect_inherits(cnd[[1]], "error_bad_length")
-cnd <- arkhe:::catch_conditions(assert_length(numeric(0), expected = 10, empty = FALSE))
+cnd <- arkhe:::catch_conditions(assert_length(numeric(), expected = 10))
 expect_inherits(cnd[[1]], "error_bad_length")
 
-expect_equal(assert_length(numeric(0), expected = 10, empty = TRUE), numeric(0))
+expect_identical(assert_length(numeric(), expected = 10, allow_empty = TRUE), numeric())
 expect_identical(assert_length(LETTERS, expected = 26), LETTERS)
 
 ## Lengths ---------------------------------------------------------------------
@@ -71,6 +71,12 @@ k <- matrix(1, nrow = 10, ncol = 5)
 cnd <- arkhe:::catch_conditions(assert_dimensions(k, expected = c(5, 10)))
 expect_inherits(cnd[[1]], "error_bad_dimensions")
 
+cnd <- arkhe:::catch_conditions(assert_nrow(k, expected = 5))
+expect_inherits(cnd[[1]], "error_bad_dimensions")
+
+cnd <- arkhe:::catch_conditions(assert_ncol(k, expected = 10))
+expect_inherits(cnd[[1]], "error_bad_dimensions")
+
 expect_identical(assert_dimensions(k, expected = c(10, 5)), k)
 
 ## Names -----------------------------------------------------------------------