Skip to content

Commit

Permalink
issues #85 and #77
Browse files Browse the repository at this point in the history
  • Loading branch information
@tonyfischetti
tonyfischetti committed Jun 11, 2019
1 parent 0675740 commit c8197bb
Show file tree
Hide file tree
Showing 3 changed files with 40 additions and 33 deletions.
28 changes: 23 additions & 5 deletions R/assertions.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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")
Expand All @@ -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)
Expand Down Expand Up @@ -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"))){
Expand All @@ -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)
Expand Down Expand Up @@ -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"))){
Expand All @@ -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]])})
Expand Down Expand Up @@ -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))
Expand All @@ -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)
Expand Down
1 change: 0 additions & 1 deletion R/assertr.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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")}
#'
Expand Down
44 changes: 17 additions & 27 deletions tests/testthat/test-assertions.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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")
})

######################################
Expand Down Expand Up @@ -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")
})

######################################
Expand Down Expand Up @@ -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")
})
Expand Down Expand Up @@ -375,22 +375,22 @@ 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")
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)),
"no applicable method for 'select.?' applied to an object of class \"lm\"")
"argument \"row_reduction_fn\" is missing, with no default")
})

###########################################
Expand Down Expand Up @@ -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

Expand All @@ -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.
})
Expand All @@ -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() ##
Expand All @@ -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.

Expand All @@ -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.
})
Expand Down

0 comments on commit c8197bb

Please sign in to comment.