Nothing
# just some set up
a <- 1
alist <- list(a=c(1,2,3), b=c(4,5,6))
our.iris <- iris
our.iris.2 <- our.iris
our.iris.2[106,1] <- 7
our.iris.3 <- our.iris.2
our.iris.3[c(118, 119, 123, 132, 131, 136), 1] <- 7
exmpl.data <- data.frame(x=c(8, 9, 6, 5, 9, 5, 6, 7,
8, 9, 6, 5, 5, 6, 7),
y=c(82, 91, 61, 49, 40, 49, 57, 74,
78, 90, 61, 49, 51, 62, 68))
nexmpl.data <- exmpl.data
nexmpl.data[12,2] <- NA
mnexmpl.data <- nexmpl.data
mnexmpl.data[12,1] <- NA
nanmnexmpl.data <- mnexmpl.data
nanmnexmpl.data[10,1] <- 0/0
test.df <- data.frame(x = c(0, 1, 2))
test.df2 <- data.frame(x = c(0, 1, 2),
y = c(2, 1.5, 1),
z = c(0,NA, -1))
# custom error (or success) messages
not.helpful <- function(message, ...){
stop("unspecified error", call.=FALSE)
}
give.validation <- function(data, ...){
return("great job!")
}
just.show.error <- function(err, ...){
lapply(err, summary)
}
# helper functions for verifying success_append results
success_result <- function(verb, the_call, columns, row_redux_call, description) {
row_redux_message <- ""
if (!is.na(row_redux_call))
row_redux_message <- paste0(" on ", row_redux_call, " row reduction")
msg <- paste0("verification [", the_call, "]", row_redux_message, " passed!")
success <- list(
verb = verb,
message = msg,
call = the_call,
columns = columns,
row_redux_call = row_redux_call,
description = description
)
class(success) <- c("assertr_success", "success", "condition")
list(success)
}
get_assertr_success <- function(assertion) {
attr(assertion, "assertr_success")
}
############### verify ###############
test_that("verify returns data if verification passes", {
expect_equal(verify(mtcars, drat > 2), mtcars)
expect_equal(verify(mtcars, mtcars$drat > 2), mtcars)
expect_equal(verify(mtcars, mtcars$drat > 2), mtcars)
expect_equal(verify(mtcars, nrow(mtcars) > 30), mtcars)
expect_equal(verify(mtcars, am %in% c(0,1,2)), mtcars)
expect_equal(verify(mtcars, am %in% c(0,1)), mtcars)
# looks to parent frame scope?
expect_equal(verify(mtcars, a > 0), mtcars)
expect_equal(verify(mtcars, nrow(iris) > 140), mtcars)
expect_equal(verify(alist, length(a) > 0), alist)
# respects scoping rules?
expect_equal(verify(alist, length(a) > 2), alist)
expect_equal(verify(alist, length(a) > 2 && length(b) > 2), alist)
expect_equal(verify(alist, a >= 1 & b > 2), alist)
expect_equal(verify(alist, a > 2 | b > 2), alist)
expect_equal(verify(alist, 3 > 2), alist)
})
test_that("verify returns TRUE if verification passes (and we use `success_logical`)", {
expect_true(verify(mtcars, drat > 2, success_fun=success_logical))
expect_true(verify(mtcars, mtcars$drat > 2, success_fun=success_logical))
expect_true(verify(mtcars, mtcars$drat > 2, success_fun=success_logical))
expect_true(verify(mtcars, nrow(mtcars) > 30, success_fun=success_logical))
expect_true(verify(mtcars, am %in% c(0,1,2), success_fun=success_logical))
expect_true(verify(mtcars, am %in% c(0,1), success_fun=success_logical))
# looks to parent frame scope?
expect_true(verify(mtcars, a > 0, success_fun=success_logical))
expect_true(verify(mtcars, nrow(iris) > 140, success_fun=success_logical))
expect_true(verify(alist, length(a) > 0, success_fun=success_logical))
# respects scoping rules?
expect_true(verify(alist, length(a) > 2, success_fun=success_logical))
expect_true(verify(alist, length(a) > 2 && length(b) > 2, success_fun=success_logical))
expect_true(verify(alist, a >= 1 & b > 2, success_fun=success_logical))
expect_true(verify(alist, a > 2 | b > 2, success_fun=success_logical))
expect_true(verify(alist, 3 > 2, success_fun=success_logical))
})
test_that("verify returns success results if verification passes (and we use `success_append`)", {
expect_equal(
get_assertr_success(verify(mtcars, drat > 2, success_fun=success_append)),
success_result("verify", "drat > 2", NA, NA, NA))
expect_equal(
get_assertr_success(verify(mtcars, mtcars$drat > 2, success_fun=success_append)),
success_result("verify", "mtcars$drat > 2", NA, NA, NA))
expect_equal(
get_assertr_success(verify(mtcars, mtcars$drat > 2, success_fun=success_append)),
success_result("verify", "mtcars$drat > 2", NA, NA, NA))
expect_equal(
get_assertr_success(verify(mtcars, nrow(mtcars) > 30, success_fun=success_append)),
success_result("verify", "nrow(mtcars) > 30", NA, NA, NA))
expect_equal(
get_assertr_success(verify(mtcars, am %in% c(0,1,2), success_fun=success_append)),
success_result("verify", "am %in% c(0, 1, 2)", NA, NA, NA))
expect_equal(
get_assertr_success(verify(mtcars, am %in% c(0,1), success_fun=success_append)),
success_result("verify", "am %in% c(0, 1)", NA, NA, NA))
# looks to parent frame scope?
expect_equal(
get_assertr_success(verify(mtcars, a > 0, success_fun=success_append)),
success_result("verify", "a > 0", NA, NA, NA))
expect_equal(
get_assertr_success(verify(mtcars, nrow(iris) > 140, success_fun=success_append)),
success_result("verify", "nrow(iris) > 140", NA, NA, NA))
expect_equal(
get_assertr_success(verify(alist, length(a) > 0, success_fun=success_append)),
success_result("verify", "length(a) > 0", NA, NA, NA))
# respects scoping rules?
expect_equal(
get_assertr_success(verify(alist, length(a) > 2, success_fun=success_append)),
success_result("verify", "length(a) > 2", NA, NA, NA))
expect_equal(
get_assertr_success(verify(alist, length(a) > 2 && length(b) > 2, success_fun=success_append)),
success_result("verify", "length(a) > 2 && length(b) > 2", NA, NA, NA))
expect_equal(
get_assertr_success(verify(alist, a >= 1 & b > 2, success_fun=success_append)),
success_result("verify", "a >= 1 & b > 2", NA, NA, NA))
expect_equal(
get_assertr_success(verify(alist, a > 2 | b > 2, success_fun=success_append)),
success_result("verify", "a > 2 | b > 2", NA, NA, NA))
expect_equal(
get_assertr_success(verify(alist, 3 > 2, success_fun=success_append)),
success_result("verify", "3 > 2", NA, NA, NA))
})
test_that("verify performs custom success function if verification passes", {
expect_equal(verify(mtcars, drat > 2, success_fun=give.validation),
"great job!")
expect_equal(verify(mtcars, mtcars$drat > 2, function(x, ...){return("noice!")}),
"noice!")
})
test_that("verify raises error if verification fails", {
expect_equal(verify(mtcars, drat > 3, error_fun = error_logical), FALSE)
expect_output(verify(mtcars, drat > 3, error_fun = just.show.error),
"verification \\[drat > 3\\] failed! \\(4 failures\\)")
expect_equal(verify(mtcars, nrow(mtcars) > 34, error_fun = error_logical), FALSE)
expect_output(verify(mtcars, nrow(mtcars) > 34, error_fun = just.show.error),
"verification \\[nrow\\(mtcars\\) > 34\\] failed! \\(1 failure\\)")
expect_equal(verify(mtcars, am %in% c(1,2), error_fun = error_logical), FALSE)
expect_output(verify(mtcars, am %in% c(1,2), error_fun = just.show.error),
"verification \\[am %in% c\\(1, 2\\)\\] failed! \\(19 failures\\)")
# looks to parent frame scope?
expect_equal(verify(mtcars, a < 0, error_fun = error_logical), FALSE)
expect_output(verify(mtcars, a < 0, error_fun = just.show.error),
"verification \\[a < 0\\] failed! \\(1 failure\\)")
# respects scoping rules?
expect_equal(verify(alist, length(a) == 1, error_fun = error_logical), FALSE)
expect_output(verify(alist, length(a) == 1, error_fun = just.show.error),
"verification \\[length\\(a\\) == 1\\] failed! \\(1 failure\\)")
expect_equal(verify(alist, length(a) > 4, error_fun = error_logical), FALSE)
expect_output(verify(alist, length(a) > 4, error_fun = just.show.error),
"verification \\[length\\(a\\) > 4\\] failed! \\(1 failure\\)")
expect_output(verify(alist, length(a) > 2 && length(b) > 3, error_fun = just.show.error),
"verification \\[length\\(a\\) > 2 && length\\(b\\) > 3\\] failed! \\(1 failure\\)")
expect_output(verify(alist, a >= 2 | b > 4, error_fun = just.show.error),
"verification \\[a >= 2 | b > 4\\] failed! \\(1 failure\\)")
expect_output(verify(alist, 2 > 4, error_fun = just.show.error),
"verification \\[2 > 4\\] failed! \\(1 failure\\)")
# NA values don't compare TRUE
expect_output(verify(test.df2, z > -2, error_fun = just.show.error),
"verification \\[z > -2\\] failed! \\(1 failure\\)")
})
test_that("verify breaks appropriately", {
expect_error(verify(4 > 2), "argument \"expr\" is missing, with no default")
expect_error(verify(mtcars), "argument \"expr\" is missing, with no default")
expect_error(verify(MTCARS, 2 > 1),
"object 'MTCARS' not found")
expect_warning(expect_warning(
verify(mtcars, 1),
"coercing argument of type 'double' to logical"),
"The result of evaluating '1' is not a logical vector"
)
expect_error(suppressWarnings(verify(mtcars, "1")),
"missing value where TRUE/FALSE needed")
expect_error(verify(mtcars, 1 > 0, "tree"), "could not find function \"success_fun\"")
expect_error(verify(mtcars, d > 1), "object 'd' not found")
})
test_that("verify works within functions", {
my_verify <- function(data, expr, success_fun) {
verify(data, !!rlang::enexpr(expr), success_fun=success_fun)
}
expect_true(my_verify(mtcars, drat > 2, success_fun=success_logical))
})
test_that("verify works with long predicates (fix #80)", {
my_data <- data.frame(COMMENT=c("foo", "bar", "baz", "Positive Pre-dose"),
USUBJID = "ABCDEFGHIJKLMNOPQRTSU",
stringsAsFactors=FALSE)
expect_output(
expect_error(
verify(my_data,
is.na(COMMENT) | (COMMENT %in% "Positive Pre-dose" & USUBJID %in% "ABCDEFGHIJKLMNOPQRTSU")),
"assertr stopped execution"
),
regexp='is.na(COMMENT) | (COMMENT %in% "Positive Pre-dose" & USUBJID %in% "ABCDEFGHIJKLMNOPQRTSU")',
fixed=TRUE
)
})
test_that("skip_chain_opts doesn't affect functionality outside chain for verify", {
expect_equal(verify(mtcars, mtcars$drat > 2, skip_chain_opts=TRUE), mtcars)
expect_equal(verify(mtcars, nrow(mtcars) > 30, skip_chain_opts=TRUE), mtcars)
expect_true(verify(mtcars, mtcars$drat > 2, success_fun=success_logical, skip_chain_opts=TRUE))
expect_true(verify(mtcars, nrow(mtcars) > 30, success_fun=success_logical, skip_chain_opts=TRUE))
expect_equal(verify(mtcars, drat > 3, error_fun=error_logical, skip_chain_opts=TRUE), FALSE)
expect_output(verify(mtcars, drat > 3, error_fun=just.show.error, skip_chain_opts=TRUE),
"verification \\[drat > 3\\] failed! \\(4 failures\\)")
})
######################################
############### assert ###############
test_that("assert returns data if verification passes", {
expect_equal(assert(mtcars, in_set(0,1), vs, am), mtcars)
expect_equal(assert(mtcars, within_bounds(3,5), gear), mtcars)
expect_equal(assert(mtcars, is.numeric, mpg:carb), mtcars)
expect_equal(assert(mtcars, not_na, vs), mtcars)
expect_equal(assert(mtcars, not_na, mpg:carb), mtcars)
# lambdas
expect_equal(assert(mtcars, function(x) x%%1==0, cyl, vs, am, gear, carb), mtcars)
expect_equal(assert(mtcars, function(x) if(x%%1!=0) return(FALSE), gear), mtcars)
expect_equal(assert(iris, function(x) nchar(as.character(x)) > 5, Species),
iris)
})
test_that("assert returns TRUE if verification passes (w/ `success_logical`)", {
expect_true(assert(mtcars, in_set(0,1), vs, am, success_fun=success_logical))
expect_true(assert(mtcars, within_bounds(3,5), gear, success_fun=success_logical))
expect_true(assert(mtcars, is.numeric, mpg:carb, success_fun=success_logical))
expect_true(assert(mtcars, not_na, vs, success_fun=success_logical))
expect_true(assert(mtcars, not_na, mpg:carb, success_fun=success_logical))
# lambdas
# expect_true(assert(mtcars, function(x) x%%1==0, cyl, vs, am, gear, carb,
# success_fun=success_logical))
expect_true(assert(mtcars, function(x) if(x%%1!=0) return(FALSE), gear,
success_fun=success_logical))
expect_true(assert(iris, function(x) nchar(as.character(x)) > 5, Species,
success_fun=success_logical))
})
test_that("assert returns correct result if verification passes (w/ `success_append`)", {
expect_equal(
get_assertr_success(assert(mtcars, in_set(0,1), vs, am, success_fun=success_append)),
success_result("assert", "in_set(0, 1)", c("vs", "am"), NA, NA))
expect_equal(
get_assertr_success(assert(mtcars, within_bounds(3,5), gear, success_fun=success_append)),
success_result("assert", "within_bounds(3, 5)", "gear", NA, NA))
expect_equal(
get_assertr_success(assert(mtcars, is.numeric, mpg:carb, success_fun=success_append)),
success_result("assert", "is.numeric", colnames(mtcars), NA, NA))
expect_equal(
get_assertr_success(assert(mtcars, not_na, vs, success_fun=success_append)),
success_result("assert", "not_na", "vs", NA, NA))
expect_equal(
get_assertr_success(assert(mtcars, not_na, mpg:carb, success_fun=success_append)),
success_result("assert", "not_na", colnames(mtcars), NA, NA))
expect_equal(
get_assertr_success(assert(mtcars, function(x) x%%1==0, cyl, vs, am, gear, carb,
success_fun=success_append)),
success_result("assert", "function(x) x%%1 == 0", c("cyl", "vs", "am", "gear", "carb"), NA, NA))
expect_equal(
get_assertr_success(assert(mtcars, function(x) if(x%%1!=0) return(FALSE), gear,
success_fun=success_append)),
success_result("assert", "function(x) if (x%%1 != 0) return(FALSE)", "gear", NA, NA))
expect_equal(
get_assertr_success(assert(iris, function(x) nchar(as.character(x)) > 5, Species,
success_fun=success_append)),
success_result("assert", "function(x) nchar(as.character(x)) > 5", "Species", NA, NA))
})
test_that("assert performs custom success function if verification passes", {
expect_equal(assert(mtcars, not_na, mpg:carb, success_fun=give.validation), "great job!")
expect_equal(assert(mtcars, within_bounds(3,5), gear, success_fun=function(x, ...) {return("noice!")}), "noice!")
})
test_that("assert raises error if verification fails", {
expect_equal(assert(mtcars, within_bounds(3.5,4.5), gear, error_fun = error_logical), FALSE)
expect_output(assert(mtcars, within_bounds(3.5,4.5), gear, error_fun = just.show.error),
"Column 'gear' violates assertion 'within_bounds\\(3.5, 4.5\\)' 20 times.*")
expect_equal(assert(mtcars, within_bounds(3,5), gear, carb, error_fun = error_logical), FALSE)
expect_output(assert(mtcars, within_bounds(3,5), gear, carb, error_fun = just.show.error),
"Column 'carb' violates assertion 'within_bounds\\(3, 5\\)' 19 times")
expect_equal(assert(mtcars, within_bounds(3.5, 4.5), carb, gear, error_fun = error_logical), FALSE)
expect_output(assert(mtcars, within_bounds(3.5, 4.5), carb, gear, error_fun = just.show.error),
"Column 'carb' violates assertion 'within_bounds\\(3.5, 4.5\\)' 22 times.+Column 'gear' violates assertion 'within_bounds\\(3.5, 4.5\\)' 20 times")
})
test_that("assert raises *custom error* if verification fails", {
expect_error(assert(mtcars, within_bounds(3.5,4.5), gear, error_fun=not.helpful),
"unspecified error")
expect_error(assert(mtcars, within_bounds(3,5), gear, carb, error_fun=not.helpful),
"unspecified error")
})
test_that("assert breaks appropriately", {
expect_error(assert(in_set(0,1), mtcars$vs),
"assert requires columns to be selected. Check number of arguments")
expect_error(
object = {
assert(mtcars, in_set(0,1), vs, tree)
},
regexp = "Column `tree` doesn't exist",
class = "error"
)
expect_error(assert(mtcars, in_set(0,1), vs, "tree"))
expect_error(assert("tree"),
"argument \"predicate\" is missing, with no default")
})
test_that("skip_chain_opts doesn't affect functionality outside chain for assert", {
expect_equal(assert(mtcars, in_set(0,1), vs, am, skip_chain_opts=TRUE), mtcars)
expect_equal(assert(mtcars, within_bounds(3,5), gear, skip_chain_opts=TRUE), mtcars)
expect_true(assert(mtcars, in_set(0,1), vs, am, success_fun=success_logical, skip_chain_opts=TRUE))
expect_true(assert(mtcars, within_bounds(3,5), gear, success_fun=success_logical, skip_chain_opts=TRUE))
expect_equal(assert(mtcars, within_bounds(3.5,4.5), gear, error_fun=error_logical, skip_chain_opts=TRUE), FALSE)
expect_output(assert(mtcars, within_bounds(3.5,4.5), gear, error_fun=just.show.error, skip_chain_opts=TRUE),
"Column 'gear' violates assertion 'within_bounds\\(3.5, 4.5\\)' 20 times.*")
})
test_that("assert works with single row data.frames", {
single_row_data <- head(mtcars, 1)
expect_equal(assert(single_row_data, within_bounds(10,30), disp, error_fun = error_logical), FALSE)
expect_output(assert(single_row_data, within_bounds(10,30), disp, error_fun = just.show.error),
"Column 'disp' violates assertion 'within_bounds\\(10, 30\\)' 1 time.*")
expect_equal(assert(single_row_data, within_bounds(10,30), disp, mpg, error_fun = error_logical), FALSE)
expect_output(assert(single_row_data, within_bounds(10,30), disp, mpg, error_fun = just.show.error),
"Column 'disp' violates assertion 'within_bounds\\(10, 30\\)' 1 time.*")
})
######################################
############### assert_rows ###############
test_that("assert_rows returns data if verification passes", {
expect_equal(assert_rows(mtcars, rowSums, within_bounds(0,2), vs, am), mtcars)
expect_equal(assert_rows(mtcars, num_row_NAs, within_bounds(0,.1), dplyr::everything()),
mtcars)
expect_equal(assert_rows(mtcars, rowSums, within_bounds(5,16), cyl, carb),
mtcars)
expect_equal(assert_rows(mnexmpl.data, num_row_NAs, within_bounds(0,2),
dplyr::everything()), mnexmpl.data)
expect_equal(assert_rows(nexmpl.data, num_row_NAs, function(x) x < 2,
dplyr::everything()), nexmpl.data)
expect_equal(assert_rows(mtcars, rowSums, function(x) if(x>16) return(FALSE), carb, cyl),
mtcars)
})
test_that("assert_rows returns TRUE if verification passes (w/ `success_logical`", {
expect_true(assert_rows(mtcars, rowSums, within_bounds(0,2), vs, am, success_fun=success_logical))
expect_true(assert_rows(mtcars, num_row_NAs, within_bounds(0,.1), dplyr::everything(), success_fun=success_logical))
expect_true(assert_rows(mtcars, rowSums, within_bounds(5,16), cyl, carb, success_fun=success_logical))
expect_true(assert_rows(mnexmpl.data, num_row_NAs, within_bounds(0,2),
dplyr::everything(), success_fun=success_logical))
expect_true(assert_rows(nexmpl.data, num_row_NAs, function(x) x < 2,
dplyr::everything(), success_fun=success_logical))
expect_true(assert_rows(mtcars, rowSums, function(x) if(x>16) return(FALSE), carb, cyl, success_fun=success_logical))
})
test_that("assert_rows returns correct result if verification passes (w/ `success_append`", {
expect_equal(
get_assertr_success(assert_rows(mtcars, rowSums, within_bounds(0,2), vs, am, success_fun=success_append)),
success_result("assert_rows", "within_bounds(0, 2)", c("vs", "am"), "rowSums", NA))
expect_equal(
get_assertr_success(assert_rows(mtcars, num_row_NAs, within_bounds(0,.1), dplyr::everything(), success_fun=success_append)),
success_result("assert_rows", "within_bounds(0, 0.1)", colnames(mtcars), "num_row_NAs", NA))
expect_equal(
get_assertr_success(assert_rows(mtcars, rowSums, within_bounds(5,16), cyl, carb, success_fun=success_append)),
success_result("assert_rows", "within_bounds(5, 16)", c("cyl", "carb"), "rowSums", NA))
expect_equal(
get_assertr_success(assert_rows(mnexmpl.data, num_row_NAs, within_bounds(0,2),
dplyr::everything(), success_fun=success_append)),
success_result("assert_rows", "within_bounds(0, 2)", colnames(mnexmpl.data), "num_row_NAs", NA))
expect_equal(
get_assertr_success(assert_rows(nexmpl.data, num_row_NAs, function(x) x < 2,
dplyr::everything(), success_fun=success_append)),
success_result("assert_rows", "function(x) x < 2", colnames(mnexmpl.data), "num_row_NAs", NA))
expect_equal(
get_assertr_success(assert_rows(mtcars, rowSums, function(x) if(x>16) return(FALSE), carb, cyl, success_fun=success_append)),
success_result("assert_rows", "function(x) if (x > 16) return(FALSE)", c("carb", "cyl"), "rowSums", NA))
})
test_that("assert_rows performs custom success function if verification passes", {
expect_equal(assert_rows(mtcars, rowSums, within_bounds(0,2), vs, am, success_fun=give.validation), "great job!")
expect_equal(assert_rows(mtcars, rowSums, within_bounds(5,16), cyl, carb, success_fun=function(x, ...) {return("noice!")}), "noice!")
})
test_that("assert_rows raises error if verification fails", {
expect_output(assert_rows(mtcars, rowSums, within_bounds(1,2), vs, am, error_fun = just.show.error),
"Data frame row reduction 'rowSums' violates predicate 'within_bounds\\(1, 2\\)' 12 times")
expect_output(assert_rows(mtcars, num_row_NAs, within_bounds(1,2), dplyr::everything(), error_fun = just.show.error),
"Data frame row reduction 'num_row_NAs' violates predicate 'within_bounds\\(1, 2\\)' 32 times")
expect_output(assert_rows(mtcars, rowSums, function(x) if(x==10) return(FALSE), carb, cyl, error_fun = just.show.error),
"Data frame row reduction 'rowSums' violates predicate 'function\\(x\\) if \\(x == 10\\) return\\(FALSE\\)' 8 times")
expect_output(assert_rows(mnexmpl.data, num_row_NAs, within_bounds(0,1), dplyr::everything(), error_fun = just.show.error),
"Data frame row reduction 'num_row_NAs' violates predicate 'within_bounds\\(0, 1\\)' 1 time")
})
test_that("assert_rows raises *custom error* if verification fails", {
expect_error(assert_rows(mnexmpl.data, num_row_NAs, within_bounds(0,1), dplyr::everything(), error_fun=not.helpful),
"unspecified error")
})
test_that("assert_rows breaks appropriately", {
expect_error(assert_rows(in_set(0,1), mtcars$vs),
"argument \"predicate\" is missing, with no default")
expect_error(assert_rows(rowSums, in_set(0,1), mtcars$vs),
"assert_rows requires columns to be selected. Check number of arguments")
expect_error(
object = {
assert_rows(
data = mtcars,
row_reduction_fn = rowSums,
predicate = in_set(0,1,2),
vs,
am,
tree
)
},
regexp = "Column `tree` doesn't exist",
class = "error"
)
expect_error(assert_rows(mtcars, rowSums, in_set(0,1,2), vs, am, "tree"))
expect_error(assert_rows("tree"),
"argument \"row_reduction_fn\" is missing, with no default")
})
test_that("skip_chain_opts doesn't affect functionality outside chain for assert_rows", {
expect_equal(assert_rows(mtcars, rowSums, within_bounds(0,2), vs, am, skip_chain_opts=TRUE), mtcars)
expect_equal(assert_rows(mtcars, num_row_NAs, within_bounds(0,.1), dplyr::everything(), skip_chain_opts=TRUE),
mtcars)
expect_true(assert_rows(mtcars, rowSums, within_bounds(0,2), vs, am, success_fun=success_logical, skip_chain_opts=TRUE))
expect_true(assert_rows(mtcars, num_row_NAs, within_bounds(0,.1), dplyr::everything(), success_fun=success_logical, skip_chain_opts=TRUE))
expect_output(assert_rows(mtcars, rowSums, within_bounds(1,2), vs, am, error_fun=just.show.error, skip_chain_opts=TRUE),
"Data frame row reduction 'rowSums' violates predicate 'within_bounds\\(1, 2\\)' 12 times")
expect_output(assert_rows(mtcars, num_row_NAs, within_bounds(1,2), dplyr::everything(), error_fun=just.show.error, skip_chain_opts=TRUE),
"Data frame row reduction 'num_row_NAs' violates predicate 'within_bounds\\(1, 2\\)' 32 times")
})
######################################
############### insist ###############
test_that("insist returns data if verification passes", {
expect_equal(insist(our.iris, within_n_sds(3), Sepal.Length), our.iris)
expect_equal(insist(our.iris.3, within_n_sds(2), Sepal.Length), our.iris.3)
expect_equal(insist(our.iris, within_n_sds(4), Sepal.Length:Petal.Width),
our.iris)
})
test_that("insist returns TRUE if verification passes (w/ success_logical)", {
expect_true(insist(our.iris, within_n_sds(3), Sepal.Length, success_fun=success_logical))
expect_true(insist(our.iris.3, within_n_sds(2), Sepal.Length, success_fun=success_logical))
expect_true(insist(our.iris, within_n_sds(4), Sepal.Length:Petal.Width, success_fun=success_logical))
})
test_that("insist returns correct result if verification passes (w/ `success_append`", {
expect_equal(
get_assertr_success(insist(our.iris, within_n_sds(3), Sepal.Length, success_fun=success_append)),
success_result("insist", "within_n_sds(3)", "Sepal.Length", NA, NA))
expect_equal(
get_assertr_success(insist(our.iris.3, within_n_sds(2), Sepal.Length, success_fun=success_append)),
success_result("insist", "within_n_sds(2)", "Sepal.Length", NA, NA))
expect_equal(
get_assertr_success(insist(our.iris, within_n_sds(4), Sepal.Length:Petal.Width, success_fun=success_append)),
success_result("insist", "within_n_sds(4)", c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width"), NA, NA))
})
test_that("insist performs custom success function if verification passes", {
expect_equal(insist(our.iris, within_n_sds(3), Sepal.Length, success_fun=give.validation), "great job!")
expect_equal(insist(our.iris.3, within_n_sds(2), Sepal.Length, success_fun=function(x, ...){return("noice!")}), "noice!")
})
test_that("insist raises error if verification fails", {
expect_output(insist(our.iris, within_n_sds(2), Sepal.Length, error_fun = just.show.error),
"Column 'Sepal.Length' violates assertion 'within_n_sds\\(2\\)' 6 times")
expect_output(insist(our.iris.2, within_n_sds(2), Sepal.Length, error_fun = just.show.error),
"Column 'Sepal.Length' violates assertion 'within_n_sds\\(2\\)' 5 times")
expect_output(insist(our.iris, within_n_sds(3), Sepal.Length:Petal.Width, error_fun = just.show.error),
"Column 'Sepal.Width' violates assertion 'within_n_sds\\(3\\)' 1 time")
expect_output(insist(our.iris, within_n_sds(2), Sepal.Length:Petal.Width, error_fun = just.show.error),
"Column 'Sepal.Length' violates assertion 'within_n_sds\\(2\\)' 6 times.*Column 'Sepal.Width' violates assertion 'within_n_sds\\(2\\)' 5 times")
})
test_that("insist raises *custom error* if verification fails", {
expect_error(insist(our.iris, within_n_sds(2), Sepal.Length, error_fun=not.helpful),
"unspecified error")
expect_error(insist(our.iris.2, within_n_sds(2), Sepal.Length, error_fun=not.helpful),
"unspecified error")
})
test_that("insist breaks appropriately", {
expect_error(insist(within_n_sds(5), mtcars$vs),
"insist requires columns to be selected. Check number of arguments")
expect_error(insist(mtcars, within_n_sds(5), "vs:am"))
expect_error(
object = {
insist(data = mtcars, predicate_generator = within_n_sds(5), tree)
},
regexp = "Column `tree` doesn't exist",
class = "error"
)
expect_error(insist("tree"),
"argument \"predicate_generator\" is missing, with no default")
expect_error(insist(iris, within_n_sds(5), Petal.Width:Species),
"argument must be a numeric vector")
})
test_that("skip_chain_opts doesn't affect functionality outside chain for insist", {
expect_equal(insist(our.iris, within_n_sds(3), Sepal.Length, skip_chain_opts=TRUE), our.iris)
expect_equal(insist(our.iris.3, within_n_sds(2), Sepal.Length, skip_chain_opts=TRUE), our.iris.3)
expect_equal(insist(our.iris, within_n_sds(3), Sepal.Length, success_fun=give.validation, skip_chain_opts=TRUE),
"great job!")
expect_equal(insist(our.iris.3, within_n_sds(2), Sepal.Length, success_fun=function(x, ...){return("noice!")}, skip_chain_opts=TRUE),
"noice!")
expect_output(insist(our.iris, within_n_sds(2), Sepal.Length, error_fun=just.show.error, skip_chain_opts=TRUE),
"Column 'Sepal.Length' violates assertion 'within_n_sds\\(2\\)' 6 times")
expect_output(insist(our.iris.2, within_n_sds(2), Sepal.Length, error_fun=just.show.error, skip_chain_opts=TRUE),
"Column 'Sepal.Length' violates assertion 'within_n_sds\\(2\\)' 5 times")
})
######################################
############### insist rows ###############
test_that("insist_rows returns data if verification passes", {
expect_equal(insist_rows(our.iris, maha_dist, within_n_sds(6), dplyr::everything()), our.iris)
expect_equal(insist_rows(our.iris, maha_dist, within_n_mads(10), Sepal.Length:Species), our.iris)
expect_equal(insist_rows(our.iris, maha_dist, within_n_mads(11), Sepal.Length:Petal.Width),
our.iris)
})
test_that("insist_rows returns correct result if verification passes (w/ `success_append`", {
expect_equal(
get_assertr_success(insist_rows(our.iris, maha_dist, within_n_sds(6), dplyr::everything(), success_fun=success_append)),
success_result("insist_rows", "within_n_sds(6)", colnames(our.iris), "maha_dist", NA))
expect_equal(
get_assertr_success(insist_rows(our.iris, maha_dist, within_n_mads(10), Sepal.Length:Species, success_fun=success_append)),
success_result("insist_rows", "within_n_mads(10)", colnames(our.iris), "maha_dist", NA))
expect_equal(
get_assertr_success(insist_rows(our.iris, maha_dist, within_n_mads(11), Sepal.Length:Petal.Width, success_fun=success_append)),
success_result("insist_rows", "within_n_mads(11)", c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width"), "maha_dist", NA))
})
test_that("insist_rows raises error if verification fails", {
expect_output(insist_rows(our.iris, maha_dist, within_n_sds(4), dplyr::everything(), error_fun = just.show.error),
"Data frame row reduction 'maha_dist' violates predicate 'within_n_sds\\(4\\)' 1 time")
expect_output(insist_rows(our.iris, maha_dist, within_n_sds(2), dplyr::everything(), error_fun = just.show.error),
"Data frame row reduction 'maha_dist' violates predicate 'within_n_sds\\(2\\)' 8 times")
expect_output(insist_rows(our.iris, maha_dist, within_n_mads(5), Sepal.Length:Species, error_fun = just.show.error),
"Data frame row reduction 'maha_dist' violates predicate 'within_n_mads\\(5\\)' 1 time")
expect_output(insist_rows(our.iris, maha_dist, within_n_mads(5), Sepal.Length:Petal.Width, error_fun = just.show.error),
"Data frame row reduction 'maha_dist' violates predicate 'within_n_mads\\(5\\)' 4 times")
})
test_that("insist_rows raises *custom error* if verification fails", {
expect_error(insist_rows(our.iris, maha_dist, within_n_mads(5), Sepal.Length:Petal.Width, error_fun = not.helpful),
"unspecified error")
})
test_that("insist_rows breaks appropriately", {
expect_error(insist_rows(within_n_sds(5), mtcars$vs),
"argument \"predicate_generator\" is missing, with no default")
expect_error(insist_rows(mtcars, within_n_sds(10), vs),
"object 'vs' not found")
expect_error(insist_rows(mtcars, maha_dist, within_n_sds(10), vs),
"\"data\" needs to have at least two columns")
expect_error(insist_rows(mtcars, maha_dist, within_bound(0, 10), vs, am),
"could not find function \"within_bound\"")
expect_error(insist_rows(), "argument \"row_reduction_fn\" is missing, with no default")
expect_error(insist_rows(mtcars), "argument \"row_reduction_fn\" is missing, with no default")
expect_error(insist_rows(mtcars, maha_dist, am, vs),
"object 'am' not found")
expect_error(insist_rows(mtcars, maha_dist, am, vs, carb),
"object 'am' not found")
expect_error(insist_rows(lm(Petal.Length ~ Petal.Width, data=iris)),
"argument \"row_reduction_fn\" is missing, with no default")
})
test_that("skip_chain_opts doesn't affect functionality outside chain for insist_rows", {
expect_equal(insist_rows(our.iris, maha_dist, within_n_sds(6), dplyr::everything(), skip_chain_opts=TRUE),
our.iris)
expect_equal(insist_rows(our.iris, maha_dist, within_n_mads(10), Sepal.Length:Species, skip_chain_opts=TRUE),
our.iris)
expect_output(insist_rows(our.iris, maha_dist, within_n_sds(4), dplyr::everything(), error_fun=just.show.error, skip_chain_opts=TRUE),
"Data frame row reduction 'maha_dist' violates predicate 'within_n_sds\\(4\\)' 1 time")
expect_output(insist_rows(our.iris, maha_dist, within_n_sds(2), dplyr::everything(), error_fun=just.show.error, skip_chain_opts=TRUE),
"Data frame row reduction 'maha_dist' violates predicate 'within_n_sds\\(2\\)' 8 times")
expect_error(insist_rows(within_n_sds(5), mtcars$vs, skip_chain_opts=TRUE),
"argument \"predicate_generator\" is missing, with no default")
expect_error(insist_rows(mtcars, within_n_sds(10), vs, skip_chain_opts=TRUE),
"object 'vs' not found")
})
###########################################
########## chaining works ############
# A special error function for these tests, produces the error but no
# standard output.
error_no_output <- function (list_of_errors, data=NULL, ...) {
stop("assertr stopped execution", call.=FALSE)
}
strip_attributes <- function(d){
attr(d, "assertr_in_chain_error_fun_override") <- NULL
attr(d, "assertr_in_chain_success_fun_override") <- NULL
d
}
ret_num_off_errors <- function(errors, data=NULL, warn=FALSE, ...){
if(!is.null(data) && !is.null(attr(data, "assertr_errors")))
errors <- append(attr(data, "assertr_errors"), errors)
num.of.errors <- length(errors)
cat(sprintf("There %s %d error%s:\n",
ifelse(num.of.errors==1,"is", "are"),
num.of.errors,
ifelse(num.of.errors==1,"", "s")))
}
success_message <- function(data=NULL, ...) {
message("Assertion passed")
return(data)
}
error_message <- function(errors, data=NULL) {
message("Assertion failed")
return(data)
}
##### !!! chaining: assert
test_that("assert works with chaining", {
# only assert with no error
code_to_test <- function() {
test.df %>%
chain_start %>%
assert(in_set(0,1,2), x) %>%
chain_end %>% strip_attributes
}
expect_equal(code_to_test(), test.df)
# only assert with no error stores success correctly
code_to_test <- function() {
test.df %>%
chain_start(store_success = TRUE) %>%
assert(in_set(0,1,2), x) %>%
chain_end %>% strip_attributes
}
expect_equal(
get_assertr_success(code_to_test()),
success_result("assert", "in_set(0, 1, 2)", "x", NA, NA))
# only assert with print state on success in chain
code_to_test <- function() {
test.df %>%
chain_start %>%
assert(in_set(0,1,2), x, success_fun=success_message, skip_chain_opts=TRUE) %>%
chain_end %>% strip_attributes
}
expect_message(code_to_test(), "Assertion passed")
# only assert with error
code_to_test <- function() {
test.df %>%
chain_start %>%
assert(in_set(0,1), x) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_output(code_to_test(), "There is 1 error")
# only assert with printed state on error in chain
code_to_test <- function() {
test.df %>%
chain_start %>%
assert(in_set(0,1), x, error_fun=error_message, skip_chain_opts=TRUE) %>%
chain_end %>% strip_attributes
}
expect_message(code_to_test(), "Assertion failed")
# two asserts with no error
code_to_test <- function() {
test.df2 %>%
chain_start %>%
assert(in_set(0,1,2), x) %>%
assert(within_bounds(1,2),y) %>%
chain_end %>% strip_attributes
}
expect_equal(code_to_test(), test.df2)
# two asserts with no error and storing success results
code_to_test <- function() {
test.df2 %>%
chain_start(store_success=TRUE) %>%
assert(in_set(0,1,2), x) %>%
assert(within_bounds(1,2),y) %>%
chain_end %>% strip_attributes
}
expect_equal(
get_assertr_success(code_to_test()),
append(
success_result("assert", "in_set(0, 1, 2)", "x", NA, NA),
success_result("assert", "within_bounds(1, 2)", "y", NA, NA)
)
)
# only assert with error (1st)
code_to_test <- function() {
test.df2 %>%
chain_start %>%
assert(in_set(0,1), x) %>%
assert(within_bounds(1,2),y) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_output(code_to_test(), "There is 1 error")
# two asserts with error (1st) and chain callback overwriten
code_to_test <- function() {
test.df2 %>%
chain_start %>%
assert(in_set(0,1), x, error_fun=error_message, skip_chain_opts=TRUE) %>%
assert(within_bounds(1,2),y) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_message(code_to_test(), "Assertion failed")
# only assert with error (2st)
code_to_test <- function() {
test.df2 %>%
chain_start %>%
assert(within_bounds(1,2),y) %>%
assert(in_set(0,1), x) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_output(code_to_test(), "There is 1 error")
# only assert with two errors
code_to_test <- function() {
test.df2 %>%
chain_start %>%
assert(within_bounds(1,1.5),y) %>%
assert(in_set(0,1), x) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_output(code_to_test(), "There are 2 errors")
# two asserts with two errors and one callback overwritten in chain
code_to_test <- function() {
test.df2 %>%
chain_start %>%
assert(within_bounds(1,1.5),y, error_fun=error_message, skip_chain_opts=TRUE) %>%
assert(in_set(0,1), x) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_output(expect_message(code_to_test(), "Assertion failed"), "There is 1 error")
})
##### !!! chaining: assert_rows
test_that("assert_rows works with chaining", {
# only assert_rows with no error
code_to_test <- function() {
test.df2 %>%
chain_start %>%
assert_rows(col_concat, is_uniq, x, y) %>%
chain_end %>% strip_attributes
}
expect_equal(code_to_test(), test.df2)
# only assert_rows with no error and storing success result
code_to_test <- function() {
test.df2 %>%
chain_start(store_success=TRUE) %>%
assert_rows(col_concat, is_uniq, x, y) %>%
chain_end %>% strip_attributes
}
expect_equal(
get_assertr_success(code_to_test()),
success_result("assert_rows", "is_uniq", c("x", "y"), "col_concat", NA)
)
# only assert_rows with print state on success in chain
code_to_test <- function() {
test.df2 %>%
chain_start %>%
assert_rows(col_concat, is_uniq, x, y, success_fun=success_message, skip_chain_opts=TRUE) %>%
chain_end %>% strip_attributes
}
expect_message(code_to_test(), "Assertion passed")
# only assert_row with error
code_to_test <- function() {
test.df2 %>%
chain_start %>%
assert_rows(rowSums, not_na, x, y, z) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_output(code_to_test(), "There is 1 error")
# only assert_rows with printed state on error in chain
code_to_test <- function() {
test.df2 %>%
chain_start %>%
assert_rows(rowSums, not_na, x, y, z, error_fun=error_message, skip_chain_opts=TRUE) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_message(code_to_test(), "Assertion failed")
# two asserts_row with no error
code_to_test <- function() {
test.df2 %>%
chain_start %>%
assert_rows(rowSums, is.numeric, x, y, z) %>%
assert_rows(col_concat, is.character, x, y, z) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_equal(code_to_test(), test.df2)
# two asserts_row with no error ans storing success
code_to_test <- function() {
test.df2 %>%
chain_start(store_success=TRUE) %>%
assert_rows(rowSums, is.numeric, x, y, z) %>%
assert_rows(col_concat, is.character, x, y, z) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_equal(
get_assertr_success(code_to_test()),
append(
success_result("assert_rows", "is.numeric", c("x", "y", "z"), "rowSums", NA),
success_result("assert_rows", "is.character", c("x", "y", "z"), "col_concat", NA)
)
)
# only assert_rows with error (1st)
code_to_test <- function() {
test.df2 %>%
chain_start %>%
assert_rows(rowSums, is.character, x, y, z) %>%
assert_rows(col_concat, is.character, x, y, z) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_output(code_to_test(), "There is 1 error")
# two assert_rows with error (1st) and callback overwritten in chain
code_to_test <- function() {
test.df2 %>%
chain_start %>%
assert_rows(rowSums, is.character, x, y, z, error_fun=error_message, skip_chain_opts=TRUE) %>%
assert_rows(col_concat, is.character, x, y, z) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_message(code_to_test(), "Assertion failed")
# only assert_rows with error (2st)
code_to_test <- function() {
test.df2 %>%
chain_start %>%
assert_rows(col_concat, is.character, x, y, z) %>%
assert_rows(rowSums, is.character, x, y, z) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_output(code_to_test(), "There is 1 error")
# only assert_rows with two error
code_to_test <- function() {
test.df2 %>%
chain_start %>%
assert_rows(col_concat, is.numeric, x, y, z) %>%
assert_rows(rowSums, is.character, x, y, z) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_output(code_to_test(), "There are 2 errors")
# only assert_rows with two errors and one callback overwritten in chain
code_to_test <- function() {
test.df2 %>%
chain_start %>%
assert_rows(col_concat, is.numeric, x, y, z, error_fun=error_message, skip_chain_opts=TRUE) %>%
assert_rows(rowSums, is.character, x, y, z) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_output(expect_message(code_to_test(), "Assertion failed"))
})
##### !!! chaining: insist
test_that("insist works with chaining", {
# only insist with no error
code_to_test <- function() {
test.df2 %>%
chain_start %>%
insist(within_n_mads(5), x, y, z) %>%
chain_end %>% strip_attributes
}
expect_equal(code_to_test(), test.df2)
# only insist with no error ans storing success
code_to_test <- function() {
test.df2 %>%
chain_start(store_success=TRUE) %>%
insist(within_n_mads(5), x, y, z) %>%
chain_end %>% strip_attributes
}
expect_equal(
get_assertr_success(code_to_test()),
success_result("insist", "within_n_mads(5)", c("x", "y", "z"), NA, NA)
)
# only insist with print state on success in chain
code_to_test <- function() {
test.df2 %>%
chain_start %>%
insist(within_n_mads(5), x, y, z, success_fun=success_message, skip_chain_opts=TRUE) %>%
chain_end %>% strip_attributes
}
expect_message(code_to_test(), "Assertion passed")
# only insist with error (3 of them, though)
code_to_test <- function() {
test.df2 %>%
chain_start %>%
insist(within_n_mads(.4), x, y, z) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_output(code_to_test(), "There are 3 errors")
# only insist with printed state on error in chain
code_to_test <- function() {
test.df2 %>%
chain_start %>%
insist(within_n_mads(.4), x, y, z, error_fun=error_message, skip_chain_opts=TRUE) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_message(code_to_test(), "Assertion failed")
# two insists with no error
code_to_test <- function() {
test.df2 %>%
chain_start %>%
insist(within_n_mads(5), x, y, z) %>%
insist(within_n_sds(5), x, y, z) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_equal(code_to_test(), test.df2)
# two insists with no error and storing success
code_to_test <- function() {
test.df2 %>%
chain_start(store_success=TRUE) %>%
insist(within_n_mads(5), x, y, z) %>%
insist(within_n_sds(5), x, y, z) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_equal(
get_assertr_success(code_to_test()),
append(
success_result("insist", "within_n_mads(5)", c("x", "y", "z"), NA, NA),
success_result("insist", "within_n_sds(5)", c("x", "y", "z"), NA, NA)
)
)
# two insists with error (1st)
code_to_test <- function() {
test.df2 %>%
chain_start %>%
insist(within_n_mads(.4), x, y, z) %>%
insist(within_n_sds(5), x, y, z) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_output(code_to_test(), "There are 3 errors")
# two insists with error (1st) and callback overwritten in chain
code_to_test <- function() {
test.df2 %>%
chain_start %>%
insist(within_n_mads(.4), x, y, z, error_fun=error_message, skip_chain_opts=TRUE) %>%
insist(within_n_sds(5), x, y, z) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_message(code_to_test(), "Assertion failed")
# two insists with error (2st)
code_to_test <- function() {
test.df2 %>%
chain_start %>%
insist(within_n_sds(5), x, y, z) %>%
insist(within_n_mads(.4), x, y, z) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_output(code_to_test(), "There are 3 errors")
# two insists with two error
code_to_test <- function() {
test.df2 %>%
chain_start %>%
insist(within_n_sds(.4), x, y, z) %>%
insist(within_n_mads(.4), x, y, z) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_output(code_to_test(), "There are 6 errors")
# two insists with two errors and one callback overwritten in chain
code_to_test <- function() {
test.df2 %>%
chain_start %>%
insist(within_n_sds(.4), x, y, z, error_fun=error_message, skip_chain_opts=TRUE) %>%
insist(within_n_mads(.4), x, y, z) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_output(expect_message(code_to_test(), "Assertion failed"))
})
##### !!! chaining: insist_rows
test_that("insist_rows works with chaining", {
# only insist_rows with no error
code_to_test <- function() {
test.df2 %>%
chain_start %>%
insist_rows(maha_dist, function(x){function(...) TRUE}, x, y, z) %>%
chain_end %>% strip_attributes
}
expect_equal(code_to_test(), test.df2)
# only insist_rows with no error and storing success
code_to_test <- function() {
test.df2 %>%
chain_start(store_success=TRUE) %>%
insist_rows(maha_dist, function(x){function(...) TRUE}, x, y, z) %>%
chain_end %>% strip_attributes
}
expect_equal(
get_assertr_success(code_to_test()),
success_result("insist_rows", as.character(expression(function(x){function(...) TRUE})), c("x", "y", "z"), "maha_dist", NA)
)
# only insist_rows with print state on success in chain
code_to_test <- function() {
test.df2 %>%
chain_start %>%
insist_rows(maha_dist, function(x){function(...) TRUE}, x, y, z, success_fun=success_message, skip_chain_opts=TRUE) %>%
chain_end %>% strip_attributes
}
expect_message(code_to_test(), "Assertion passed")
# only insist_rows with error (3 of them, though)
code_to_test <- function() {
test.df2 %>%
chain_start %>%
insist_rows(maha_dist, function(x){function(...) FALSE}, x, y, z) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_output(code_to_test(), "There is 1 error")
# only insist_rows with printed state on error in chain
code_to_test <- function() {
test.df2 %>%
chain_start %>%
insist_rows(maha_dist, function(x){function(...) FALSE}, x, y, z, error_fun=error_message, skip_chain_opts=TRUE) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_message(code_to_test(), "Assertion failed")
# two insists_rows with no error
code_to_test <- function() {
test.df2 %>%
chain_start %>%
insist_rows(maha_dist, function(x){function(...) TRUE}, x, y, z) %>%
insist_rows(col_concat, function(x){function(...) TRUE}, x, y, z) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_equal(code_to_test(), test.df2)
# two insists_rows with no error and storing success results
code_to_test <- function() {
test.df2 %>%
chain_start(store_success=TRUE) %>%
insist_rows(maha_dist, function(x){function(...) TRUE}, x, y, z) %>%
insist_rows(col_concat, function(x){function(...) TRUE}, x, y, z) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_equal(
get_assertr_success(code_to_test()),
append(
success_result("insist_rows", as.character(expression(function(x){function(...) TRUE})), c("x", "y", "z"), "maha_dist", NA),
success_result("insist_rows", as.character(expression(function(x){function(...) TRUE})), c("x", "y", "z"), "col_concat", NA)
)
)
# two insists_rows with error (1st)
code_to_test <- function() {
test.df2 %>%
chain_start %>%
insist_rows(maha_dist, function(x){function(...) FALSE}, x, y, z) %>%
insist_rows(col_concat, function(x){function(...) TRUE}, x, y, z) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_output(code_to_test(), "There is 1 error")
# two insists_rows with error (1st) and callback overwritten in chain
code_to_test <- function() {
test.df2 %>%
chain_start %>%
insist_rows(maha_dist, function(x){function(...) FALSE}, x, y, z, error_fun=error_message, skip_chain_opts=TRUE) %>%
insist_rows(col_concat, function(x){function(...) TRUE}, x, y, z) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_message(code_to_test(), "Assertion failed")
# two insists with error (2st)
code_to_test <- function() {
test.df2 %>%
chain_start %>%
insist_rows(col_concat, function(x){function(...) TRUE}, x, y, z) %>%
insist_rows(maha_dist, function(x){function(...) FALSE}, x, y, z) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_output(code_to_test(), "There is 1 error")
# two insists_rows with two errors
code_to_test <- function() {
test.df2 %>%
chain_start %>%
insist_rows(col_concat, function(x){function(...) FALSE}, x, y, z) %>%
insist_rows(maha_dist, function(x){function(...) FALSE}, x, y, z) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_output(code_to_test(), "There are 2 errors")
# two insists_rows with two errors and one callback overwritten in chain
code_to_test <- function() {
test.df2 %>%
chain_start %>%
insist_rows(col_concat, function(x){function(...) FALSE}, x, y, z, error_fun=error_message, skip_chain_opts=TRUE) %>%
insist_rows(maha_dist, function(x){function(...) FALSE}, x, y, z) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_output(expect_message(code_to_test(), "Assertion failed"), "There is 1 error")
})
##### !!! chaining: verify
test_that("verify works with chaining", {
# only verify with no error
code_to_test <- function() {
test.df2 %>%
chain_start %>%
verify(x >= 0) %>%
chain_end %>% strip_attributes
}
expect_equal(code_to_test(), test.df2)
# only verify with no error ans storing success results
code_to_test <- function() {
test.df2 %>%
chain_start(store_success=TRUE) %>%
verify(x >= 0) %>%
chain_end %>% strip_attributes
}
expect_equal(
get_assertr_success(code_to_test()),
success_result("verify", "x >= 0", NA, NA, NA)
)
# only verify with print state on success in chain
code_to_test <- function() {
test.df2 %>%
chain_start %>%
verify(x >= 0, success_fun=success_message, skip_chain_opts=TRUE) %>%
chain_end %>% strip_attributes
}
expect_message(code_to_test(), "Assertion passed")
# only verify with error
code_to_test <- function() {
test.df2 %>%
chain_start %>%
verify(x > 0) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_output(code_to_test(), "There is 1 error")
# only verify with printed state on error in chain
code_to_test <- function() {
test.df2 %>%
chain_start %>%
verify(x > 0, error_fun=error_message, skip_chain_opts=TRUE) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_message(code_to_test(), "Assertion failed")
# two verify with no error
code_to_test <- function() {
test.df2 %>%
chain_start %>%
verify(x >= 0) %>%
verify(y > 0) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_equal(code_to_test(), test.df2)
# two verify with no error and storing success results
code_to_test <- function() {
test.df2 %>%
chain_start(store_success=TRUE) %>%
verify(x >= 0) %>%
verify(y > 0) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_equal(
get_assertr_success(code_to_test()),
append(
success_result("verify", "x >= 0", NA, NA, NA),
success_result("verify", "y > 0", NA, NA, NA)
)
)
# two verify with error (1st)
code_to_test <- function() {
test.df2 %>%
chain_start %>%
verify(x > 0) %>%
verify(y > 0) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_output(code_to_test(), "There is 1 error")
# two verify with error (1st) and callback overwritten in chain
code_to_test <- function() {
test.df2 %>%
chain_start %>%
verify(x > 0, error_fun=error_message, skip_chain_opts=TRUE) %>%
verify(y > 0) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_message(code_to_test(), "Assertion failed")
# two verify with error (2st)
code_to_test <- function() {
test.df2 %>%
chain_start %>%
verify(y > 0) %>%
verify(x > 0) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_output(code_to_test(), "There is 1 error")
# two verify with two errors
code_to_test <- function() {
test.df2 %>%
chain_start %>%
verify(y > 2) %>%
verify(x > 0) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_output(code_to_test(), "There are 2 errors")
# two verify with two errors and one callback overwritten in chain
code_to_test <- function() {
test.df2 %>%
chain_start %>%
verify(y > 2, error_fun=error_message, skip_chain_opts=TRUE) %>%
verify(x > 0) %>%
chain_end(error_fun=ret_num_off_errors) %>% strip_attributes
}
expect_output(expect_message(code_to_test(), "Assertion failed"), "There is 1 error")
})
###################################
##### !!! rlang .data and unquoting
test_that("all assertions work with .data pronoun without chains", {
# Define some data we might accidentally reference outside the test.df frame
y <- 0:2
## verify() ##
# Cases where the name exists:
# Also test the logical versions here to make sure nothing too weird is happening.
expect_equal(verify(test.df, .data$x <= 2), test.df) # expect success
expect_true(verify(test.df, .data$x <= 2, success_fun = success_logical))
expect_output(verify(test.df, .data$x > 2, error_fun = just.show.error),
"verification [.data$x > 2] failed! (3 failures)", fixed = TRUE)
expect_false(verify(test.df, .data$x > 2, error_fun = error_logical))
# Cases where the name doesn't exist:
expect_error(verify(test.df, .data$y <= 2, error_fun = just.show.error))
# expect success from y defined above
expect_equal(verify(test.df, y <= 2), test.df)
## assert() ##
expect_equal(assert(test.df, within_bounds(-Inf, 2), x), test.df)
expect_output(
expect_error(assert(test.df, within_bounds(2, Inf), x)),
regexp="Column 'x' violates assertion 'within_bounds(2, Inf)' 2 times",
fixed=TRUE
)
## insist() ##
expect_equal(insist(test.df, within_n_sds(1), x), test.df)
expect_output(insist(test.df, within_n_sds(0.1), x,
error_fun = just.show.error),
"Column 'x' violates assertion 'within_n_sds(0.1)' 2 times", fixed = TRUE)
})
test_that("all assertions work with .data pronoun in chains", {
# Define some data we might accidentally reference outside the test.df frame
y <- 0:2
## verify() ##
# Cases where the name exists:
# Also test the logical versions here to make sure nothing too weird is happening.
expect_equal(test.df %>% verify(x <= 2), test.df)
expect_true(test.df %>% verify(x <= 2, success_fun = success_logical))
expect_output(test.df %>% verify(x > 2, error_fun = just.show.error),
"verification [x > 2] failed! (3 failures)", fixed = TRUE)
expect_false(test.df %>% verify(x > 2, error_fun = error_logical))
# Cases where the name doesn't exist:
#expect_error(test.df %>% verify(y <= 2, error_fun = just.show.error))
expect_error(test.df %>% verify(.data$y <= 2, error_fun = just.show.error))
expect_equal(test.df %>% verify(y <= 2), test.df)
## assert() ##
expect_equal(test.df %>% assert(within_bounds(-Inf, 2), x), test.df)
expect_output(test.df %>% assert(within_bounds(2, Inf), x,
error_fun = just.show.error),
"Column 'x' violates assertion 'within_bounds(2, Inf)' 2 times", fixed = TRUE)
## insist() ##
expect_equal(test.df %>% insist(within_n_sds(1), x), test.df)
expect_output(test.df %>% insist(within_n_sds(0.1), x,
error_fun = just.show.error),
"Column 'x' violates assertion 'within_n_sds(0.1)' 2 times", fixed = TRUE)
})
test_that("all assertions work with !! unquoting", {
x <- 2:4
y <- 0:2
z <- 3
varname <- rlang::quo(x)
## verify() ##
expect_equal(verify(test.df, !! x > 1), test.df) # 2:4 > 1
expect_equal(verify(test.df, !! x > .data$x), test.df) # 2:4 > .data$x
expect_equal(verify(test.df, !! y == .data$x), test.df) # 0:2 == .data$x
expect_equal(verify(test.df, !! varname < 3), test.df) # x < 3
expect_output(verify(test.df, !! x < 1, error_fun = just.show.error),
"verification [2:4 < 1] failed! (3 failures)", fixed = TRUE)
expect_output(verify(test.df, !! x < x, error_fun = just.show.error),
"verification [2:4 < x] failed! (3 failures)", fixed = TRUE)
expect_output(verify(test.df, !! y != x, error_fun = just.show.error),
"verification [0:2 != x] failed! (3 failures)", fixed = TRUE)
expect_output(verify(test.df, !! varname > 3, error_fun = just.show.error),
# this is a weird error message, but it's fine I guess
"verification [(~x) > 3] failed! (3 failures)", fixed = TRUE)
## assert() ##
# Note that !!min(x) becomes min(2:4), so this works:
expect_equal(assert(test.df, within_bounds(-Inf, !!min(x)), x), test.df)
expect_equal(assert(test.df, within_bounds(-Inf, 2), !! varname), test.df)
expect_output(assert(test.df, within_bounds(2, Inf), !! varname,
error_fun = just.show.error),
"Column 'x' violates assertion 'within_bounds(2, Inf)' 2 times",
fixed = TRUE)
expect_output(assert(test.df, within_bounds(!!z-1, Inf), x,
error_fun = just.show.error),
"Column 'x' violates assertion 'within_bounds(3 - 1, Inf)' 2 times",
fixed = TRUE)
## insist() ##
expect_equal(test.df %>% insist(within_n_sds(!! z), !! varname), test.df)
expect_output(test.df %>% insist(within_n_sds(!! z/10), !! varname,
error_fun = just.show.error),
"Column 'x' violates assertion 'within_n_sds(3/10)' 2 times", fixed = TRUE)
})
test_that("verify works with variable-argument-length is_uniq", {
# These x, y, z should not be used by the is_uniq below because the
# predicates use a data mask
x <- 2:4
y <- 0:2
z <- 3
varname <- rlang::quo(x)
# test.df2 <- data.frame(x = c(0, 1, 2),
# y = c(2, 1.5, 1),
# z = c(0,NA, -1))
expect_equal(verify(test.df2, is_uniq(x)), test.df2)
expect_equal(verify(test.df2, is_uniq(x, y)), test.df2)
expect_equal(verify(test.df2, is_uniq(x, y, z, allow.na=TRUE)), test.df2)
expect_equal(verify(test.df2, is_uniq(!!varname)), test.df2)
df_dups <- data.frame(x = c(0, 0, 1, 2),
y = c(1, 2, 2, NA),
z = c(1, 1, 2, 3))
expect_output(verify(df_dups, is_uniq(x, z), error_fun = just.show.error),
"verification [is_uniq(x, z)] failed! (2 failures)", fixed = TRUE)
expect_equal(verify(df_dups, is_uniq(x, y, allow.na = TRUE)), df_dups)
expect_output(verify(df_dups, is_uniq(x, y), error_fun = just.show.error),
"verification [is_uniq(x, y)] failed! (1 failure)", fixed = TRUE)
})
test_that("description is correctly stored and displayed in results", {
description <- "vs and am should be only 0 or 1."
# Error
check_error <- mtcars %>%
assert(in_set(0, 2), am, vs, error_fun = error_return,
description=description)
# error outside chain
expect_equal(
check_error[[1]][["description"]],
description
)
expect_output(
print(check_error[[1]]),
description
)
# error inside chain
check_error <- mtcars %>%
chain_start %>%
assert(in_set(0, 2), am, vs, description=description) %>%
chain_end(error_fun = error_return)
expect_equal(
check_error[[1]][["description"]],
description
)
expect_output(
print(check_error[[1]]),
description
)
# Success
check_success_df <- function() {
mtcars %>%
assert(in_set(0, 1), am, vs, success_fun=success_df_return,
description=description)
}
check_success_report <- function() {
mtcars %>%
assert(in_set(0, 1), am, vs, success_fun=success_report,
description=description)
}
# success outside chain
expect_equal(
check_success_df()[1, "description"],
description
)
expect_output(
print(check_success_report()),
description
)
# success inside chain
check_success_df <- function() {
mtcars %>%
chain_start(store_success=TRUE) %>%
assert(in_set(0, 1), am, vs, description=description) %>%
chain_end(success_fun=success_df_return)
}
check_success_report <- function() {
mtcars %>%
chain_start(store_success=TRUE) %>%
assert(in_set(0, 1), am, vs, success_fun=success_report,
description=description) %>%
chain_end(success_fun=success_df_return)
}
expect_equal(
check_success_df()[1, "description"],
description
)
expect_output(
print(check_success_report()),
description
)
# Defect
check_defect_df <- function() {
mtcars %>%
dplyr::select(-am) %>%
verify(has_all_names("am", "vs"), obligatory=TRUE, error_fun=error_append) %>%
assert(in_set(0, 1), am, vs, defect_fun=defect_df_return,
description=description)
}
check_defect_report <- function() {
mtcars %>%
dplyr::select(-am) %>%
verify(has_all_names("am", "vs"), obligatory=TRUE, error_fun=error_append) %>%
assert(in_set(0, 1), am, vs, defect_fun=defect_report,
description=description)
}
# defect outside chain
expect_equal(
check_defect_df()[1, "description"],
description
)
expect_output(
print(check_defect_report()),
description
)
# defect inside chain
check_defect_df <- function() {
mtcars %>%
select(-am) %>%
chain_start %>%
verify(has_all_names("am", "vs"), obligatory=TRUE) %>%
assert(in_set(0, 1), am, vs, description=description) %>%
chain_end(defect_fun=defect_df_return)
}
check_defect_report <- function() {
mtcars %>%
select(-am) %>%
chain_start %>%
verify(has_all_names("am", "vs"), obligatory=TRUE) %>%
assert(in_set(0, 1), am, vs, defect_fun=defect_report,
description=description) %>%
chain_end(defect_fun=defect_df_return)
}
expect_equal(
check_success_df()[1, "description"],
description
)
expect_output(
print(check_success_report()),
description
)
})
test_that("handle predicates applied to the whole data, and not to subframe", {
a_tibble <- tibble::tibble(
a = c(0, 0),
b = c(0,0)
) %>%
head( n = 0)
expect_silent({
assert(data = a_tibble, predicate = function(x) nrow(x) == 0L, dplyr::everything())
})
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.