diff --git a/DESCRIPTION b/DESCRIPTION index d18429e..2e5e4a9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: efun Title: Miscellaneous Functions by E -Version: 0.3.2 +Version: 0.3.3 Authors@R: person(given = "Eduardo", family = "Alfonso-Sierra", diff --git a/R/assert.R b/R/assert.R index c26fac4..d33c683 100644 --- a/R/assert.R +++ b/R/assert.R @@ -27,36 +27,32 @@ #' is thrown. #' #' @export -assert <- function(.data, ..., msg = "Assertion does not hold") { - # TODO: change this old approach and embrace more dplyr by something like - # abcd <- dplyr::mutate(.data, ...) - # and then just extract the evaluated conditions to report. This also - # allows multiple conditions, unlike the original approach - condition_eval <- with(.data, ...) - if (all(condition_eval)) { +assert <- function(.data, ..., msg = "Assertion does not hold", na.rm = TRUE) { + conds <- rlang::enquos(..., .named = TRUE) + conds_eval <- purrr::imap(conds, \(x, idx) rlang::eval_tidy(x, data = .data)) + + if (all(purrr::map_lgl(conds_eval, \(x) all(x, na.rm = TRUE)))) { return(.data) } else { - msg <- paste0( - msg, ": `", deparse(substitute(...)), "` is false ", - sum(!condition_eval), - " out of ", length(condition_eval), " times (", - sprintf("%.1f%%", 100 * sum(!condition_eval) / length(condition_eval)), - ")\n" - ) - cat(msg) + fail_msg <- purrr::imap(conds_eval, \(x, idx) { + n_fail <- sum(!x) + if (n_fail > 0) { + paste0( + "\t`", idx, "` is false ", + n_fail, " out of ", length(x), " times (", + sprintf("%.1f%%", 100 * n_fail / length(x)), ")\n" + ) + } + }) |> purrr::compact() # we wanto to get rid of NULL, als error msg - NULL -> .condition_eval - .assert_fails <- dplyr::mutate( - .data |> dplyr::ungroup(), - .condition_eval = condition_eval - ) + .assert_fails <- dplyr::mutate(.data, ...) if (rlang::is_interactive()) { utils::View(.assert_fails) # TODO: should we sample? } else { .assert_fails |> - dplyr::filter(!.condition_eval) |> + # dplyr::filter(!.condition_eval) |> # TODO: should we keep filtering? print() # TODO: should we sample?, or just rely on tibble's print? } - stop(msg) + stop(msg, "\n", fail_msg) } } diff --git a/tests/testthat/test-assert.R b/tests/testthat/test-assert.R index a720448..1b97f57 100644 --- a/tests/testthat/test-assert.R +++ b/tests/testthat/test-assert.R @@ -1,12 +1,42 @@ -test_that("assert works", { +test_that("assert() works", { expect_error(mtcars |> assert(mpg < 33)) expect_identical(mtcars |> assert(mpg < 34), mtcars) }) -test_that("assert does not fail on grouped data frames", { +test_that("assert() does not fail on grouped data frames", { expect_error( object = mtcars |> dplyr::group_by(cyl) |> assert(hp < 150), regexp = "Assertion does not hold" ) }) + +test_that("assert() does not fail testing data with NAs", { + expect_no_error( + object = mtcars |> + dplyr::mutate(mpg = dplyr::na_if(mpg, 15)) |> + assert(mpg > 10) + ) +}) + +test_that("assert() can handle multiple conditions", { + expect_no_error( + object = mtcars |> + dplyr::mutate(mpg = dplyr::na_if(mpg, 15)) |> + assert(hp < 1500, am < 100) + ) + + expect_error( + object = mtcars |> + dplyr::mutate(mpg = dplyr::na_if(mpg, 15)) |> + assert(hp < 1500, am < 1), + regexp = "Assertion does not hold.*am < 1.*" + ) + + expect_error( + object = mtcars |> + dplyr::mutate(mpg = dplyr::na_if(mpg, 15)) |> + assert(hp < 1, am < 100), + regexp = "Assertion does not hold.*hp < 1.*" + ) +})