32 add assertion assert length

DESCRIPTION

@@ -40,6 +40,7 @@ Collate:
     'assert_functions.R'
     'set_operations.R'
     'assert_includes.R'
+    'assert_length.R'
     'assert_names.R'
     'assert_numerical.R'
     'assert_set.R'

NAMESPACE

@@ -29,6 +29,11 @@ export(assert_greater_than_or_equal_to)
 export(assert_identical)
 export(assert_includes)
 export(assert_int)
+export(assert_length)
+export(assert_length_greater_than)
+export(assert_length_greater_than_or_equal_to)
+export(assert_length_less_than)
+export(assert_length_less_than_or_equal_to)
 export(assert_list)
 export(assert_logical)
 export(assert_logical_vector)

R/assert_length.R

@@ -0,0 +1,101 @@
+# Assert Length -----------------------------------------------------------
+
+#' Assert Length
+#'
+#' Assert object has a specific length
+#'
+#' @param x object to check length of
+#' @param length expected length (number)
+#' @param msg custom error message
+#' @param call (logical) whether to preserve call in error message
+#' @param arg_name (character) name of argument being tested
+#'
+#' @return invisible(TRUE)
+#' @export
+assert_length <- assert_create(
+  func = function(x, length) {
+    if(!is.numeric(length)) return("'length' must be numeric")
+    if(length(length) != 1) return("'length' must be a single number")
+    if(!is_whole_number(length)) return("'length' must be a whole number")
+    if(length < 0) return("'length' must be non-negative")
+
+    length(x) == length
+  },
+  default_error_msg = "'{arg_name}' must have length {length}, not {length(arg_value)}"
+)
+
+#' Assert Length Greater Than
+#'
+#' Assert object length is greater than a threshold
+#'
+#' @inheritParams assert_length
+#' @return invisible(TRUE)
+#' @export
+assert_length_greater_than <- assert_create(
+  func = function(x, length) {
+    if(!is.numeric(length)) return("'length' must be numeric")
+    if(length(length) != 1) return("'length' must be a single number")
+    if(!is_whole_number(length)) return("'length' must be a whole number")
+    if(length < 0) return("'length' must be non-negative")
+
+    length(x) > length
+  },
+  default_error_msg = "'{arg_name}' must have length greater than {length}, not {length(arg_value)}"
+)
+
+#' Assert Length Greater Than or Equal To
+#'
+#' Assert object length is greater than or equal to a threshold
+#'
+#' @inheritParams assert_length
+#' @return invisible(TRUE)
+#' @export
+assert_length_greater_than_or_equal_to <- assert_create(
+  func = function(x, length) {
+    if(!is.numeric(length)) return("'length' must be numeric")
+    if(length(length) != 1) return("'length' must be a single number")
+    if(!is_whole_number(length)) return("'length' must be a whole number")
+    if(length < 0) return("'length' must be non-negative")
+
+    length(x) >= length
+  },
+  default_error_msg = "'{arg_name}' must have length greater than or equal to {length}, not {length(arg_value)}"
+)
+
+#' Assert Length Less Than
+#'
+#' Assert object length is less than a threshold
+#'
+#' @inheritParams assert_length
+#' @return invisible(TRUE)
+#' @export
+assert_length_less_than <- assert_create(
+  func = function(x, length) {
+    if(!is.numeric(length)) return("'length' must be numeric")
+    if(length(length) != 1) return("'length' must be a single number")
+    if(!is_whole_number(length)) return("'length' must be a whole number")
+    if(length < 0) return("'length' must be non-negative")
+
+    length(x) < length
+  },
+  default_error_msg = "'{arg_name}' must have length less than {length}, not {length(arg_value)}"
+)
+
+#' Assert Length Less Than or Equal To
+#'
+#' Assert object length is less than or equal to a threshold
+#'
+#' @inheritParams assert_length
+#' @return invisible(TRUE)
+#' @export
+assert_length_less_than_or_equal_to <- assert_create(
+  func = function(x, length) {
+    if(!is.numeric(length)) return("'length' must be numeric")
+    if(length(length) != 1) return("'length' must be a single number")
+    if(!is_whole_number(length)) return("'length' must be a whole number")
+    if(length < 0) return("'length' must be non-negative")
+
+    length(x) <= length
+  },
+  default_error_msg = "'{arg_name}' must have length less than or equal to {length}, not {length(arg_value)}"
+)

tests/testthat/test-assert_length.R

@@ -0,0 +1,88 @@
+cli::test_that_cli("assert_length() works", configs = "plain", {
+  # Works for objects with correct length
+  expect_true(assert_length(1:3, 3))
+  expect_true(assert_length(c("a", "b"), 2))
+  expect_true(assert_length(list(1, 2, 3), 3))
+  expect_true(assert_length(NULL, 0))
+
+  # Aborts for objects with incorrect length
+  expect_error(assert_length(1:3, 2), "'1:3' must have length 2, not 3", fixed = TRUE)
+  expect_error(assert_length(c("a", "b"), 3), "'c(\"a\", \"b\")' must have length 3, not 2", fixed = TRUE)
+
+  # Aborts for invalid length parameter
+  expect_error(assert_length(1:3, "3"), "'length' must be numeric", fixed = TRUE)
+  expect_error(assert_length(1:3, c(2, 3)), "'length' must be a single number", fixed = TRUE)
+  expect_error(assert_length(1:3, 2.5), "'length' must be a whole number", fixed = TRUE)
+  expect_error(assert_length(1:3, -1), "'length' must be non-negative", fixed = TRUE)
+
+  # Error messages use variable name
+  x <- 1:3
+  expect_error(assert_length(x, 2), "'x' must have length 2, not 3", fixed = TRUE)
+
+  # Custom error messages work
+  expect_error(assert_length(1:3, 2, msg = "Custom error"), "Custom error", fixed = TRUE)
+})
+
+cli::test_that_cli("assert_length_greater_than() works", configs = "plain", {
+  # Works for objects with length > threshold
+  expect_true(assert_length_greater_than(1:3, 2))
+  expect_true(assert_length_greater_than(c("a", "b", "c"), 1))
+
+  # Aborts for objects with length <= threshold
+  expect_error(assert_length_greater_than(1:3, 3), "'1:3' must have length greater than 3, not 3", fixed = TRUE)
+  expect_error(assert_length_greater_than(1:3, 4), "'1:3' must have length greater than 4, not 3", fixed = TRUE)
+
+  # Aborts for invalid length parameter
+  expect_error(assert_length_greater_than(1:3, "3"), "'length' must be numeric", fixed = TRUE)
+  expect_error(assert_length_greater_than(1:3, c(2, 3)), "'length' must be a single number", fixed = TRUE)
+  expect_error(assert_length_greater_than(1:3, 2.5), "'length' must be a whole number", fixed = TRUE)
+  expect_error(assert_length_greater_than(1:3, -1), "'length' must be non-negative", fixed = TRUE)
+})
+
+cli::test_that_cli("assert_length_greater_than_or_equal_to() works", configs = "plain", {
+  # Works for objects with length >= threshold
+  expect_true(assert_length_greater_than_or_equal_to(1:3, 2))
+  expect_true(assert_length_greater_than_or_equal_to(1:3, 3))
+
+  # Aborts for objects with length < threshold
+  expect_error(assert_length_greater_than_or_equal_to(1:3, 4), 
+              "'1:3' must have length greater than or equal to 4, not 3", fixed = TRUE)
+
+  # Aborts for invalid length parameter
+  expect_error(assert_length_greater_than_or_equal_to(1:3, "3"), "'length' must be numeric", fixed = TRUE)
+  expect_error(assert_length_greater_than_or_equal_to(1:3, c(2, 3)), "'length' must be a single number", fixed = TRUE)
+  expect_error(assert_length_greater_than_or_equal_to(1:3, 2.5), "'length' must be a whole number", fixed = TRUE)
+  expect_error(assert_length_greater_than_or_equal_to(1:3, -1), "'length' must be non-negative", fixed = TRUE)
+})
+
+cli::test_that_cli("assert_length_less_than() works", configs = "plain", {
+  # Works for objects with length < threshold
+  expect_true(assert_length_less_than(1:3, 4))
+  expect_true(assert_length_less_than(c("a", "b"), 3))
+
+  # Aborts for objects with length >= threshold
+  expect_error(assert_length_less_than(1:3, 3), "'1:3' must have length less than 3, not 3", fixed = TRUE)
+  expect_error(assert_length_less_than(1:3, 2), "'1:3' must have length less than 2, not 3", fixed = TRUE)
+
+  # Aborts for invalid length parameter
+  expect_error(assert_length_less_than(1:3, "3"), "'length' must be numeric", fixed = TRUE)
+  expect_error(assert_length_less_than(1:3, c(2, 3)), "'length' must be a single number", fixed = TRUE)
+  expect_error(assert_length_less_than(1:3, 2.5), "'length' must be a whole number", fixed = TRUE)
+  expect_error(assert_length_less_than(1:3, -1), "'length' must be non-negative", fixed = TRUE)
+})
+
+cli::test_that_cli("assert_length_less_than_or_equal_to() works", configs = "plain", {
+  # Works for objects with length <= threshold
+  expect_true(assert_length_less_than_or_equal_to(1:3, 4))
+  expect_true(assert_length_less_than_or_equal_to(1:3, 3))
+
+  # Aborts for objects with length > threshold
+  expect_error(assert_length_less_than_or_equal_to(1:3, 2), 
+              "'1:3' must have length less than or equal to 2, not 3", fixed = TRUE)
+
+  # Aborts for invalid length parameter
+  expect_error(assert_length_less_than_or_equal_to(1:3, "3"), "'length' must be numeric", fixed = TRUE)
+  expect_error(assert_length_less_than_or_equal_to(1:3, c(2, 3)), "'length' must be a single number", fixed = TRUE)
+  expect_error(assert_length_less_than_or_equal_to(1:3, 2.5), "'length' must be a whole number", fixed = TRUE)
+  expect_error(assert_length_less_than_or_equal_to(1:3, -1), "'length' must be non-negative", fixed = TRUE)
+})