diff --git a/R/assertions.R b/R/assertions.R index a828a8a..b855847 100644 --- a/R/assertions.R +++ b/R/assertions.R @@ -57,7 +57,6 @@ assert <- function(data, predicate, ..., success_fun=success_continue, error_fun=error_stop){ keeper.vars <- dplyr::quos(...) - sub.frame <- dplyr::select(data, !!!(keeper.vars)) name.of.predicate <- rlang::expr_text(rlang::enexpr(predicate)) if(!is.null(attr(predicate, "call"))){ name.of.predicate <- attr(predicate, "call") @@ -80,18 +79,28 @@ assert <- function(data, predicate, ..., success_fun=success_continue, if(!is.vectorized.predicate(predicate)) predicate <- make.predicate.proper(predicate) + if(length(keeper.vars)==0) + stop("assert requires columns to be selected. Check number of arguments", call.=FALSE) + sub.frame <- dplyr::select(data, !!!(keeper.vars)) - log.mat <- sapply(names(sub.frame), + log.mat <- sapply(colnames(sub.frame), function(column){ this.vector <- sub.frame[[column]] return(apply.predicate.to.vector(this.vector, predicate))}) + if(class(log.mat)=="logical"){ + log.mat <- matrix(log.mat) + colnames(log.mat) <- colnames(sub.frame) + } + # if all checks pass *and* there are no leftover errors if(all(log.mat) && is.null(attr(data, "assertr_errors"))) return(success_fun(data)) + #print(names(log.mat)) errors <- lapply(colnames(log.mat), function(col.name){ + #errors <- lapply(names(log.mat), function(col.name){ col <- log.mat[, col.name] num.violations <- sum(!col) if(num.violations==0) @@ -171,7 +180,6 @@ assert_rows <- function(data, row_reduction_fn, predicate, ..., success_fun=success_continue, error_fun=error_stop){ keeper.vars <- dplyr::quos(...) - sub.frame <- dplyr::select(data, !!!(keeper.vars)) name.of.row.redux.fn <- rlang::expr_text(rlang::enexpr(row_reduction_fn)) name.of.predicate <- rlang::expr_text(rlang::enexpr(predicate)) if(!is.null(attr(row_reduction_fn, "call"))){ @@ -197,6 +205,10 @@ assert_rows <- function(data, row_reduction_fn, predicate, ..., if(!is.vectorized.predicate(predicate)) predicate <- make.predicate.proper(predicate) + if(length(keeper.vars)==0) + stop("assert_rows requires columns to be selected. Check number of argumentsSelect all columns with everything()", call.=FALSE) + sub.frame <- dplyr::select(data, !!!(keeper.vars)) + redux <- row_reduction_fn(sub.frame) log.vec <- apply.predicate.to.vector(redux, predicate) @@ -284,7 +296,6 @@ insist <- function(data, predicate_generator, ..., success_fun=success_continue, error_fun=error_stop){ keeper.vars <- dplyr::quos(...) - sub.frame <- dplyr::select(data, !!!(keeper.vars)) name.of.predicate.generator <- rlang::expr_text( rlang::enexpr(predicate_generator)) if(!is.null(attr(predicate_generator, "call"))){ @@ -304,6 +315,10 @@ insist <- function(data, predicate_generator, ..., error_fun <- error_fun_override } + if(length(keeper.vars)==0) + stop("insist requires columns to be selected. Check number of arguments", call.=FALSE) + sub.frame <- dplyr::select(data, !!!(keeper.vars)) + # get true predicates (not the generator) true.predicates <- sapply(names(sub.frame), function(column){predicate_generator(sub.frame[[column]])}) @@ -404,7 +419,6 @@ insist_rows <- function(data, row_reduction_fn, predicate_generator, ..., success_fun=success_continue, error_fun=error_stop){ keeper.vars <- dplyr::quos(...) - sub.frame <- dplyr::select(data, !!!(keeper.vars)) name.of.row.redux.fn <- rlang::expr_text(rlang::enexpr(row_reduction_fn)) name.of.predicate.generator <- rlang::expr_text( rlang::enexpr(predicate_generator)) @@ -428,6 +442,10 @@ insist_rows <- function(data, row_reduction_fn, predicate_generator, ..., error_fun <- error_fun_override } + if(length(keeper.vars)==0) + stop("insist_rows requires columns to be selected. Check number of arguments", call.=FALSE) + sub.frame <- dplyr::select(data, !!!(keeper.vars)) + redux <- row_reduction_fn(sub.frame) predicate <- predicate_generator(redux) diff --git a/R/assertr.R b/R/assertr.R index a41e072..8abf7b2 100644 --- a/R/assertr.R +++ b/R/assertr.R @@ -2,7 +2,6 @@ #' #' The assertr package supplies a suite of functions designed to verify #' assumptions about data early in an analysis pipeline. -#' #' See the assertr vignette or the documentation for more information \cr #' > \code{vignette("assertr")} #' diff --git a/tests/testthat/test-assertions.R b/tests/testthat/test-assertions.R index 8b9559b..2dd4afe 100644 --- a/tests/testthat/test-assertions.R +++ b/tests/testthat/test-assertions.R @@ -220,12 +220,12 @@ test_that("assert raises *custom error* if verification fails", { test_that("assert breaks appropriately", { expect_error(assert(in_set(0,1), mtcars$vs), - "no applicable method for 'select.?' applied to an object of class \"function\"") + "assert requires columns to be selected. Check number of arguments") expect_error(assert(mtcars, in_set(0,1), vs, tree), "object 'tree' not found") expect_error(assert(mtcars, in_set(0,1), vs, "tree")) expect_error(assert("tree"), - "no applicable method for 'select.?' applied to an object of class \"character\"") + "argument \"predicate\" is missing, with no default") }) ###################################### @@ -284,14 +284,14 @@ test_that("assert_rows raises *custom error* if verification fails", { test_that("assert_rows breaks appropriately", { expect_error(assert_rows(in_set(0,1), mtcars$vs), - "no applicable method for 'select.?' applied to an object of class \"function\"") + "argument \"predicate\" is missing, with no default") expect_error(assert_rows(rowSums, in_set(0,1), mtcars$vs), - "no applicable method for 'select.?' applied to an object of class \"function\"") + "assert_rows requires columns to be selected. Check number of arguments") expect_error(assert_rows(mtcars, rowSums, in_set(0,1,2), vs, am, tree), "object 'tree' not found") expect_error(assert_rows(mtcars, rowSums, in_set(0,1,2), vs, am, "tree")) expect_error(assert_rows("tree"), - "no applicable method for 'select.?' applied to an object of class \"character\"") + "argument \"row_reduction_fn\" is missing, with no default") }) ###################################### @@ -336,12 +336,12 @@ test_that("insist raises *custom error* if verification fails", { test_that("insist breaks appropriately", { expect_error(insist(within_n_sds(5), mtcars$vs), - "no applicable method for 'select.?' applied to an object of class \"function\"") + "insist requires columns to be selected. Check number of arguments") expect_error(insist(mtcars, within_n_sds(5), "vs:am")) expect_error(insist(mtcars, within_n_sds(5), tree), "object 'tree' not found") expect_error(insist("tree"), - "no applicable method for 'select.?' applied to an object of class \"character\"") + "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") }) @@ -375,14 +375,14 @@ test_that("insist_rows raises *custom error* if verification fails", { test_that("insist_rows breaks appropriately", { expect_error(insist_rows(within_n_sds(5), mtcars$vs), - "no applicable method for 'select.?' applied to an object of class \"function\"") + "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 \"data\" is missing, with no default") + 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") @@ -390,7 +390,7 @@ test_that("insist_rows breaks appropriately", { "object 'am' not found") expect_error(insist_rows(lm(Petal.Length ~ Petal.Width, data=iris)), - "no applicable method for 'select.?' applied to an object of class \"lm\"") + "argument \"row_reduction_fn\" is missing, with no default") }) ########################################### @@ -756,20 +756,15 @@ test_that("all assertions work with .data pronoun without chains", { 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), - "Column `y` not found in `.data`", fixed = TRUE) + 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), .data$x), test.df) - expect_output(assert(test.df, within_bounds(2, Inf), .data$x, - error_fun = just.show.error), - "Column 'x' violates assertion 'within_bounds(2, Inf)' 2 times", fixed = TRUE) + expect_error(assert(test.df, within_bounds(2, Inf), .data$x)) # Cases where the name doesn't exist: - expect_error(assert(test.df, within_bounds(-Inf, 2), .data$y, - error_fun = just.show.error), - "Column `y` not found in `.data`", fixed = TRUE) + expect_error(assert(test.df, within_bounds(-Inf, 2), .data$y)) # Note that assert(test.df, within_bounds(-Inf, 2), y) would not work because # assert relies on dplyr::select. Use !! varname @@ -780,8 +775,7 @@ test_that("all assertions work with .data pronoun without chains", { "Column 'x' violates assertion 'within_n_sds(0.1)' 2 times", fixed = TRUE) # Cases where the name doesn't exist: - expect_error(insist(test.df, within_n_sds(1), .data$y), - "Column `y` not found in `.data`", fixed = TRUE) + expect_error(insist(test.df, within_n_sds(1), .data$y)) # Note that insist(test.df, within_n_sds(1), y) would not work because # insist relies on dplyr::select. Use !! y instead. }) @@ -800,8 +794,7 @@ test_that("all assertions work with .data pronoun in chains", { expect_false(test.df %>% verify(.data$x > 2, error_fun = error_logical)) # Cases where the name doesn't exist: - expect_error(test.df %>% verify(.data$y <= 2, error_fun = just.show.error), - "Column `y` not found in `.data`", fixed = TRUE) + expect_error(test.df %>% verify(.data$y <= 2, error_fun = just.show.error)) expect_equal(test.df %>% verify(y <= 2), test.df) ## assert() ## @@ -810,9 +803,7 @@ test_that("all assertions work with .data pronoun in chains", { error_fun = just.show.error), "Column 'x' violates assertion 'within_bounds(2, Inf)' 2 times", fixed = TRUE) # Cases where the name doesn't exist: - expect_error(test.df %>% assert(within_bounds(-Inf, 2), .data$y, - error_fun = just.show.error), - "Column `y` not found in `.data`", fixed = TRUE) + expect_error(test.df %>% assert(within_bounds(-Inf, 2), .data$y)) # Note that test.df %>% assert(within_bounds(-Inf, 2), y) would not work because # assert relies on dplyr::select. @@ -823,8 +814,7 @@ test_that("all assertions work with .data pronoun in chains", { "Column 'x' violates assertion 'within_n_sds(0.1)' 2 times", fixed = TRUE) # Cases where the name doesn't exist: - expect_error(test.df %>% insist(within_n_sds(1), .data$y), - "Column `y` not found in `.data`", fixed = TRUE) + expect_error(test.df %>% insist(within_n_sds(1), .data$y)) # Note that test.df %>% insist(within_n_sds(1), y) would not work because # insist relies on dplyr::select. })