set.seed(1) test.vect <- rnorm(100, mean=100, sd=20) test.vect2 <- c(1, NA, 3) test.vect3 <- c(rnorm(100, mean=100, 20), 10000) ############### not_na ############### test_that("not_na returns true if not NA", { expect_equal(not_na("tree"), TRUE) expect_equal(not_na(2.8), TRUE) expect_equal(not_na(8), TRUE) }) test_that("not_na returns FALSE if NA", { expect_equal(not_na(NA), FALSE) }) test_that("not_na handles NaNs right", { expect_equal(not_na(NaN), FALSE) expect_equal(not_na(NaN, allow.NaN=FALSE), FALSE) expect_equal(not_na(NaN, allow.NaN=TRUE), TRUE) }) test_that("not_na handles vectors correctly", { expect_equal(not_na(c("tree", "arbol")), c(TRUE, TRUE)) # NaN in character string will convert to non-na string expect_equal(not_na(c("tree", "árbol", NA, "δέντρο")), c(TRUE, TRUE, FALSE, TRUE)) expect_equal(not_na(c("tree", "árbol", NA, NaN, "δέντρο")), c(TRUE, TRUE, FALSE, TRUE, TRUE)) expect_equal(not_na(c("tree", "árbol", NA, NaN, "δέντρο")), c(TRUE, TRUE, FALSE, TRUE, TRUE)) expect_equal(not_na(c("tree", "árbol", NA, NaN, "δέντρο"), allow.NaN=FALSE), c(TRUE, TRUE, FALSE, TRUE, TRUE)) expect_equal(not_na(c("tree", "árbol", NA, NaN, "δέντρο"), allow.NaN=TRUE), c(TRUE, TRUE, FALSE, TRUE, TRUE)) expect_equal(not_na(c(1, (1+1), 0/0, (6/2), NA)), c(TRUE, TRUE, FALSE, TRUE, FALSE)) expect_equal(not_na(c(1, (1+1), 0/0, (6/2), NA), allow.NaN=TRUE), c(TRUE, TRUE, TRUE, TRUE, FALSE)) }) test_that("not_na errors out when appropriate", { expect_error(not_na(c()), "not_na must be called on non-null object") expect_error(not_na(), ".x. is missing") }) test_that("predicate is tagged for assert function to vectorize", { expect_true(attr(not_na, "assertr_vectorized")) }) test_that("predicate appropriately assigns the 'call' attribute", { expect_equal(attr(not_na, "call"), "not_na") }) ###################################### ########### within_bounds ########### test_that("within_bounds fails appropriately", { expect_error(within_bounds(), ".lower.bound. is missing") expect_error(within_bounds(1, "tree"), "bounds must be numeric or have similar classes") expect_silent(within_bounds(1, "tree", check.class=FALSE)) expect_error(within_bounds(2, 1), "lower bound must be strictly lower than upper bound") expect_error(within_bounds(2, 2), "lower bound must be strictly lower than upper bound") expect_error( within_bounds("tree", "zoo")(2), "bounds must only be checked on numerics or classes that are similar" ) }) test_that("returned predicate works appropriately on scalars", { expect_equal(within_bounds(3, 4)(pi), TRUE) expect_equal(within_bounds(3, 4)(3), TRUE) expect_equal(within_bounds(3, 4, include.lower=FALSE)(3), FALSE) expect_equal(within_bounds(3, 4)(4), TRUE) expect_equal(within_bounds(3, 4, include.upper=FALSE)(4), FALSE) expect_equal(within_bounds(3, 4)(10), FALSE) expect_equal(within_bounds(3, 4)(as.numeric(NA)), TRUE) expect_equal(within_bounds(3, 4, allow.na=FALSE)(as.numeric(NA)), FALSE) expect_equal(within_bounds(0, Inf)(0), TRUE) expect_equal(within_bounds(0, Inf, include.lower=FALSE)(0), FALSE) expect_equal(within_bounds(0, Inf)(10), TRUE) expect_equal(within_bounds(0, Inf)(Inf), TRUE) expect_equal(within_bounds(0, Inf, include.upper=FALSE)(Inf), FALSE) # Non-numeric classes expect_equal(within_bounds(as.Date("2023-02-01"), as.Date("2023-02-05"))(as.Date("2023-02-03")), TRUE) expect_equal(within_bounds(as.Date("2023-02-01"), as.Date("2023-02-05"))(as.Date("2023-02-06")), FALSE) expect_equal(within_bounds("A", "D")("B"), TRUE) expect_equal(within_bounds("A", "D")("Q"), FALSE) # Classes that can be compared but are not generally similar expect_equal(within_bounds(as.Date("2023-02-01"), as.numeric(as.Date("2023-02-05")), check.class=FALSE)(as.Date("2023-02-03")), TRUE) expect_equal(within_bounds(as.Date("2023-02-01"), as.numeric(as.Date("2023-02-05")), check.class=FALSE)(as.Date("2023-02-06")), FALSE) # Classes that shouldn't be compared but can be compared, if forced expect_equal( within_bounds(1, "tree", check.class=FALSE)(2), TRUE ) expect_equal( within_bounds("tree", "zoo", check.class=FALSE)(2), FALSE ) expect_equal( suppressWarnings(within_bounds("tree", "zoo", check.class=FALSE)(factor("A"))), NA ) }) test_that("returned predicate works appropriately on vectors", { expect_equal(within_bounds(1,3)(c(0,1,2,3,4)), c(FALSE, TRUE, TRUE, TRUE, FALSE)) expect_equal(within_bounds(1,3, include.lower = FALSE)(c(0,1,2,3,4)), c(FALSE, FALSE, TRUE, TRUE, FALSE)) expect_equal(within_bounds(1,3, include.lower = FALSE, include.upper = FALSE)(c(0,1,2,3,4)), c(FALSE, FALSE, TRUE, FALSE, FALSE)) expect_equal(within_bounds(1,3)(c(0,1,2,3,4, NA, 5, NaN)), c(FALSE, TRUE, TRUE, TRUE, FALSE, TRUE, FALSE, TRUE)) expect_equal(within_bounds(1,3, allow.na=FALSE)(c(0,1,2,3,4, NA, 5, NaN)), c(FALSE, TRUE, TRUE, TRUE, FALSE, FALSE, FALSE, FALSE)) }) test_that("returned predicate fails appropriately", { expect_error(within_bounds(0,1)(), ".x. is missing") expect_error(within_bounds(0,1)("tree"), "bounds must only be checked on numerics") expect_error(within_bounds(0,1)(c("tree", 1, 2)), "bounds must only be checked on numerics") expect_error(within_bounds(0,1)(c()), "bounds must be checked on non-null element") }) test_that("returned predicate is tagged for assert function to vectorize", { expect_true(attr(within_bounds(1,2), "assertr_vectorized")) }) test_that("predicate appropriately assigns the 'call' attribute", { expect_equal(attr(within_bounds(0, test.vect[1]), "call"), "within_bounds(0, test.vect[1])") }) ##################################### ############### within_n_sds ############### test_that("returned predicate works appropriately", { expect_equal(within_n_sds(1)(test.vect)(84.3), TRUE) expect_equal(within_n_sds(1)(test.vect)(84.2), FALSE) expect_equal(within_n_sds(1)(test.vect)(c(84.3, 84.2)), c(TRUE, FALSE)) expect_equal(within_n_sds(2)(test.vect)(138.1), TRUE) expect_equal(within_n_sds(2)(test.vect)(138.11), FALSE) expect_equal(within_n_sds(2)(test.vect)(test.vect2[2]), TRUE) expect_equal(within_n_sds(2, allow.na=FALSE)(test.vect)(test.vect2[2]), FALSE) }) # the returned predicate (third inner function) will fail appropriately # given that the above "within_bounds" checks work out test_that("first inner function fails appropriately", { expect_error(within_n_sds(-1), "'n' must be a positive number") expect_error(within_n_sds(0), "'n' must be a positive number") expect_error(within_n_sds(NA), "'n' must be a positive number") expect_error(within_n_sds(c(1,2)), "'n' must be a positive number") expect_error(within_n_sds(), ".n. is missing") }) test_that("second inner function fails appropriately", { expect_error(within_n_sds(1)(), "argument .a.vector. is missing") expect_error(within_n_sds(1)(1), "standard deviations of vector is NA") expect_error(within_n_sds(1)(c("johnny", "marr")), "argument must be a numeric vector") }) test_that("returned predicate is tagged for assert function to vectorize", { expect_true(attr(within_n_sds(1)(test.vect), "assertr_vectorized")) }) test_that("predicate appropriately assigns the 'call' attribute", { expect_equal(attr(within_n_sds(100*test.vect[1]), "call"), "within_n_sds(100 * test.vect[1])") }) ############################################ ############### within_n_mads ############## test_that("returned predicate works appropriately", { expect_equal(within_n_mads(1)(test.vect3)(test.vect3[100]), TRUE) expect_equal(within_n_mads(1)(test.vect3)(test.vect3[101]), FALSE) expect_equal(within_n_mads(1)(test.vect3)(test.vect3[100:101]), c(TRUE, FALSE)) expect_equal(within_n_mads(1)(test.vect)(84.9), TRUE) expect_equal(within_n_mads(1)(test.vect)(84.8), FALSE) expect_equal(within_n_mads(2)(test.vect)(137), TRUE) expect_equal(within_n_mads(2)(test.vect)(137.1), FALSE) expect_equal(within_n_mads(2)(test.vect)(test.vect2[2]), TRUE) expect_equal(within_n_mads(2, allow.na=FALSE)(test.vect)(test.vect2[2]), FALSE) }) # the returned predicate (third inner function) will fail appropriately # given that the above "within_bounds" checks work out test_that("first inner function fails appropriately", { expect_error(within_n_mads(-1), "'n' must be a positive number") expect_error(within_n_mads(0), "'n' must be a positive number") expect_error(within_n_mads(NA), "'n' must be a positive number") expect_error(within_n_mads(c(1,2)), "'n' must be a positive number") expect_error(within_n_mads(), ".n. is missing") }) test_that("second inner function fails appropriately", { expect_error(within_n_mads(1)(), "argument .a.vector. is missing") expect_error(within_n_mads(1)(1), "MAD of vector is 0") expect_error(within_n_mads(1)(c("johnny", "marr")), "argument must be a numeric vector") }) test_that("weird edge cases", { expect_error(within_n_mads(2)(mtcars$vs), "MAD of vector is 0") }) test_that("predicate appropriately assigns the 'call' attribute", { expect_equal(attr(within_n_mads(test.vect[2]*test.vect[1]), "call"), "within_n_mads(test.vect[2] * test.vect[1])") }) ############################################ ############### in_set ############### test_that("in_set fails appropriately", { expect_error(in_set(), "can not test for membership in empty set") expect_error(in_set(,allow.na=FALSE), "argument is missing") }) test_that("returned predicate works appropriately", { expect_equal(in_set(3, 4)(pi), FALSE) expect_equal(in_set(3, 4)(4), TRUE) expect_equal(in_set(1:10)(2), TRUE) expect_equal(in_set(1:10)(11), FALSE) expect_equal(in_set(1:10)(NA), TRUE) expect_equal(in_set(1:10, allow.na = TRUE)(NA), TRUE) expect_equal(in_set(1:10, allow.na = FALSE)(NA), FALSE) expect_equal(in_set(1, "tree")("tree"), TRUE) expect_equal(in_set(1, "tree")("leaf"), FALSE) # a vector now expect_equal(in_set(3, 4)(c(4,pi)), c(TRUE, FALSE)) expect_equal(in_set(3, 4, inverse=TRUE)(c(4,pi)), c(FALSE, TRUE)) expect_equal(in_set(3, 4)(c(4,3)), c(TRUE, TRUE)) expect_equal(in_set(1:10)(1:11), c(rep(TRUE, 10), FALSE)) expect_equal(in_set(1:10, allow.na = TRUE)(c(1:10, NA)), rep(TRUE, 11)) expect_equal(in_set(1:10, allow.na = FALSE)(c(1:10, NA)), c(rep(TRUE, 10), FALSE)) }) test_that("returned predicate fails appropriately", { expect_error(in_set(0,1)(), ".x. is missing") expect_error(in_set(0,1)(c()), "nothing to check set membership to") }) test_that("returned predicate is tagged for assert function to vectorize", { expect_true(attr(in_set(1,2), "assertr_vectorized")) }) test_that("predicate appropriately assigns the 'call' attribute", { expect_equal(attr(in_set(0, 1), "call"), "in_set(0, 1)") # expect_equal(attr(in_set("ένα", "δύο", "τρία", "δέκατέσσερα"), "call"), # "in_set(\"ένα\", \"δύο\", \"τρία\", \"δέκατέσσερα\")") }) ###################################### ############### is_uniq ############### test_that("is_uniq works correctly", { expect_equal(is_uniq(c("tree", "arbol")), c(TRUE, TRUE)) expect_equal(is_uniq(c("tree", "arbol", "tree")), c(FALSE, TRUE, FALSE)) expect_equal(is_uniq(c("tree", "árbol", NA, "δέντρο")), c(TRUE, TRUE, NA, TRUE)) expect_equal(is_uniq(c("tree", "árbol", NA, "δέντρο", "δέντρο")), c(TRUE, TRUE, NA, FALSE, FALSE)) expect_equal(is_uniq(c("tree", "árbol", NA, "δέντρο"), allow.na=TRUE), c(TRUE, TRUE, TRUE, TRUE)) expect_equal(is_uniq(c("tree", "árbol", NA, "δέντρο", "δέντρο"), allow.na=TRUE), c(TRUE, TRUE, TRUE, FALSE, FALSE)) expect_equal(is_uniq(c("tree", "árbol", NA, "δέντρο", NA, "δέντρο"), allow.na=TRUE), c(TRUE, TRUE, FALSE, FALSE, FALSE, FALSE)) }) test_that("is_uniq errors out when appropriate", { expect_error(is_uniq(c()), "is_uniq must be called on non-null object") expect_error(is_uniq(), "is_uniq must be called with some arguments") # Check for argument length too expect_error(is_uniq(1:2, 1:3), "is_uniq must be called with vectors of all the same length") expect_error(is_uniq(1:2, 1), "is_uniq must be called with vectors of all the same length") expect_error(is_uniq(NULL), "is_uniq must be called on non-null objects") expect_error(is_uniq(1, NULL), "is_uniq must be called on non-null objects") # Note that this would have been a perfectly fine call before is_uniq # supported multiple vectors. The FALSE would match the allow.na argument expect_error(is_uniq(1:2, FALSE)) }) test_that("predicate is tagged for assert function to vectorize", { expect_true(attr(is_uniq, "assertr_vectorized")) }) test_that("predicate appropriately assigns the 'call' attribute", { expect_equal(attr(is_uniq, "call"), "is_uniq") }) test_that("is_uniq works with multiple vectors", { v1 <- c("a", "b", "b", "c") v2 <- c(1, 1, 2, 3) v3 <- c(1, 2, 2, 3) v4 <- c(1, NA, 2, 3) list_col <- list(list(1, 2), list(1, 2), list(3,4), list("b")) expect_equal(is_uniq(list_col), c(FALSE, FALSE, TRUE, TRUE)) expect_equal(is_uniq(v1, v1), c(TRUE, FALSE, FALSE, TRUE)) expect_equal(is_uniq(v1, v2), c(TRUE, TRUE, TRUE, TRUE)) expect_equal(is_uniq(v1, v3), c(TRUE, FALSE, FALSE, TRUE)) expect_equal(is_uniq(v1, v4), c(TRUE, NA, TRUE, TRUE)) expect_equal(is_uniq(v1, v4, allow.na = TRUE), c(TRUE, TRUE, TRUE, TRUE)) # Test numeric to numeric expect_equal(is_uniq(v3, v4), c(TRUE, NA, TRUE, TRUE)) expect_equal(is_uniq(v4, v4, allow.na = TRUE), c(TRUE, TRUE, TRUE, TRUE)) # test lists expect_equal(is_uniq(list_col, list_col), c(FALSE, FALSE, TRUE, TRUE)) expect_equal(is_uniq(list_col, v2), c(FALSE, FALSE, TRUE, TRUE)) expect_equal(is_uniq(list_col, v3), c(TRUE, TRUE, TRUE, TRUE)) expect_equal(is_uniq(list_col, v4), c(TRUE, NA, TRUE, TRUE)) expect_equal(is_uniq(list_col, v4, allow.na = TRUE), c(TRUE, TRUE, TRUE, TRUE)) # Test >2 vectors expect_equal(is_uniq(v1, v2, v3), c(TRUE, TRUE, TRUE, TRUE)) expect_equal(is_uniq(v1, v2, v4), c(TRUE, NA, TRUE, TRUE)) expect_equal(is_uniq(v1, v2, v4, allow.na = TRUE), c(TRUE, TRUE, TRUE, TRUE)) }) ######################################