assertthat/0000755000176200001440000000000013073245215012436 5ustar liggesusersassertthat/tests/0000755000176200001440000000000013072753133013602 5ustar liggesusersassertthat/tests/testthat.R0000644000176200001440000000010013072003306015542 0ustar liggesuserslibrary(testthat) library(assertthat) test_check("assertthat") assertthat/tests/testthat/0000755000176200001440000000000013073245215015440 5ustar liggesusersassertthat/tests/testthat/test-scalar.R0000644000176200001440000000271713072003306020004 0ustar liggesuserscontext("Scalar assertions") test_that("is.scalar works correctly", { expect_true(is.scalar(1)) expect_true(is.scalar(-1)) expect_true(is.scalar(1.5)) expect_false(is.scalar(1:5)) expect_true(is.scalar('a')) expect_false(is.scalar(c('a', 'b'))) expect_true(is.scalar(TRUE)) expect_false(is.scalar(c(TRUE, FALSE))) expect_false(is.scalar(NULL)) expect_true(is.scalar(NA)) }) test_that("is.string works correctly", { expect_false(is.string(1)) expect_true(is.string('a')) expect_false(is.string(c('a', 'b'))) expect_false(is.string(TRUE)) expect_false(is.string(NULL)) expect_false(is.string(NA)) }) test_that("is.number works correctly", { expect_true(is.number(1)) expect_true(is.number(-1)) expect_true(is.number(1.5)) expect_false(is.number(1:5)) expect_false(is.number('a')) expect_false(is.number(TRUE)) expect_false(is.number(NULL)) expect_false(is.number(NA)) }) test_that("is.flag works correctly", { expect_false(is.flag(1)) expect_false(is.flag('a')) expect_true(is.flag(TRUE)) expect_true(is.flag(FALSE)) expect_false(is.flag(c(TRUE, FALSE))) expect_false(is.flag(NULL)) expect_equal(is.flag(NA), is.logical(NA)) # not obvious }) test_that("is.count works correctly", { expect_true(is.count(1)) expect_false(is.count(-1)) expect_false(is.count(1.5)) expect_false(is.count(1:5)) expect_false(is.count('a')) expect_false(is.count(TRUE)) expect_false(is.count(NULL)) expect_false(is.count(NA)) }) assertthat/tests/testthat/test-file.R0000644000176200001440000000215213072003306017447 0ustar liggesuserscontext("File assertions") test_that("is.dir identifies dirs correctly", { expect_true(is.dir(tempdir())) expect_error(is.dir(tempfile())) }) test_that("is.writeable works correctly", { expect_true(is.writeable(tempdir())) tf <- tempfile() expect_error(is.writeable(tf)) # file doesn't exist yet cat("foo", file=tf) expect_true(is.writeable(tf)) # ...but now it does }) test_that("is.readable works correctly", { expect_true(is.readable(tempdir())) tf <- tempfile() expect_error(is.readable(tf)) # file doesn't exist yet cat("foo", file=tf) expect_true(is.readable(tf)) # ...but now it does }) test_that("has_extension works correctly", { # no extension tf <- tempfile() expect_true(has_extension(tf, "")) expect_false(has_extension(tf, "x")) # normal extension ext <- "test" tf <- tempfile(fileext=paste0(".", ext)) expect_true(has_extension(tf, ext)) expect_false(has_extension(tf, paste0(ext, "x"))) # empty extension ext <- "" tf <- tempfile(fileext=paste0(".", ext)) expect_true(has_extension(tf, ext)) expect_false(has_extension(tf, paste0(ext, "x"))) }) assertthat/tests/testthat/test-assertions.R0000644000176200001440000000561713072003306020733 0ustar liggesuserscontext("Assertion assertions") test_that("is.integerish works correctly", { expect_true(is.integerish(1L)) expect_true(is.integerish(c(1L, 2L, 3L))) expect_true(is.integerish(c(1L, NA, 3L))) expect_false(is.integerish(c(1L, 2.1, 3L))) # base::.Machine holds info on machine numerical precision expect_false(is.integerish(1L + .Machine$double.eps)) expect_false(is.integerish(1L - .Machine$double.neg.eps)) expect_false(is.integerish(NA)) expect_false(is.integerish(NULL)) }) test_that("is.named works correctly", { expect_false(is.named(1)) x <- 1:3 expect_false(is.named(x)) names(x) <- letters[1:3] expect_true(is.named(x)) # Malformed or weird names names(x)[2] <- "" expect_false(is.named(x)) names(x)[2] <- NA expect_false(is.named(x)) names(x) <- NULL expect_false(is.named(x)) expect_false(is.named(NA)) expect_false(is.named(NULL)) }) test_that("has_attr works correctly", { x <- 1:3 expect_false(has_attr(x, "names")) names(x) <- letters[1:3] expect_true(has_attr(x, "names")) expect_false(has_attr(x, "something else")) # not sure what else to test here }) test_that("has_name works correctly", { x <- 1:3 expect_false(has_name(x, "a")) names(x) <- letters[1:3] expect_true(has_name(x, letters[2])) expect_false(has_name(x, "something else")) expect_false(has_name(x, NA)) }) test_that("noNA works correctly", { expect_true(noNA("a")) expect_false(noNA(c(TRUE, NA))) x <- sample(c(1:10, NA), 100, rep = TRUE) expect_false(noNA(x)) expect_true(noNA(1:1000)) }) test_that("are_equal works correctly", { x <- 2 expect_false(are_equal(x, 1.9)) expect_true(are_equal(x, 1.999, tol = 0.01)) expect_true(are_equal(x, 2)) expect_true(are_equal('a', 'a')) expect_false(are_equal('a', 'b')) expect_true(are_equal(NA, NA)) expect_true(are_equal(NULL, NULL)) }) test_that("is.error works correctly", { x <- try(stop("!!"), silent=TRUE) expect_true(is.error(x)) expect_false(is.error(1)) expect_false(is.error(NA)) expect_false(is.error(NULL)) }) test_that("is.time works correctly", { expect_true(is.time(Sys.time())) expect_false(is.time(Sys.Date())) expect_false(is.time(1)) expect_false(is.time(NA)) expect_false(is.time(NULL)) }) test_that("is.date works correctly", { expect_false(is.date(Sys.time())) expect_true(is.date(Sys.Date())) expect_false(is.date(1)) expect_false(is.date(NA)) expect_false(is.date(NULL)) }) test_that("has_args works correctly", { expect_error(1 %has_args% "x") expect_true(mean %has_args% "x") expect_false(mean %has_args% "y") expect_error(NA %has_args% "x") expect_error(NULL %has_args% "x") }) test_that("not_empty works correctly", { expect_true(not_empty(1)) expect_false(not_empty(numeric())) expect_false(not_empty(mtcars[0, ])) expect_false(not_empty(mtcars[, 0])) expect_true(not_empty(NA)) expect_false(not_empty(NULL)) }) assertthat/tests/testthat/test-base.R0000644000176200001440000000102113072003306017434 0ustar liggesuserscontext("Base assertions") test_that("any message is useful", { expect_equal(validate_that(any(TRUE, FALSE)), TRUE) x <- c(FALSE, FALSE) expect_equal(validate_that(any(x)), "No elements of x are true") }) test_that("all message is useful", { expect_equal(validate_that(all(TRUE, TRUE)), TRUE) x <- c(FALSE, TRUE) expect_match(validate_that(all(x)), "Elements .* of x are not true") }) test_that("custom message is printed", { expect_equal(validate_that(FALSE, msg = "Custom message"), "Custom message") }) assertthat/NAMESPACE0000644000176200001440000000101213072003332013636 0ustar liggesusers# Generated by roxygen2: do not edit by hand export("%has_args%") export("%has_attr%") export("%has_name%") export("on_failure<-") export(are_equal) export(assert_that) export(has_args) export(has_attr) export(has_extension) export(has_name) export(is.count) export(is.date) export(is.dir) export(is.error) export(is.flag) export(is.number) export(is.readable) export(is.scalar) export(is.string) export(is.time) export(is.writeable) export(noNA) export(not_empty) export(on_failure) export(see_if) export(validate_that) assertthat/R/0000755000176200001440000000000013072003306012627 5ustar liggesusersassertthat/R/base.r0000644000176200001440000000005012247641636013740 0ustar liggesusersbase_fs <- new.env(parent = emptyenv()) assertthat/R/assert-that.r0000644000176200001440000000732313072003306015256 0ustar liggesusers#' Assert that certain conditions are true. #' #' \code{assert_that} is a drop-in replacement for \code{\link{stopifnot}} but #' is designed to give informative error messages. #' #' @section Assertions: #' #' Assertion functions should return a single \code{TRUE} or \code{FALSE}: #' any other result is an error, and \code{assert_that} will complain about #' it. This will always be the case for the assertions provided by #' \code{assertthat}, but you may need be a more careful for #' base R functions. #' #' To make your own assertions that work with \code{assert_that}, #' see the help for \code{\link{on_failure}}. Alternatively, a custom message #' can be specified for each call. #' #' @param ... unnamed expressions that describe the conditions to be tested. #' Rather than combining expressions with \code{&&}, separate them by commas #' so that better error messages can be generated. #' @param env (advanced use only) the environment in which to evaluate the #' assertions. #' @param msg a custom error message to be printed if one of the conditions is #' false. #' @seealso \code{\link{validate_that}}, which returns a message (not an error) #' if the condition is false. #' @export #' @examples #' x <- 1 #' # assert_that() generates errors, so can't be usefully run in #' # examples #' \dontrun{ #' assert_that(is.character(x)) #' assert_that(length(x) == 3) #' assert_that(is.dir("asdf")) #' y <- tempfile() #' writeLines("", y) #' assert_that(is.dir(y)) #' assert_that(FALSE, msg = "Custom error message") #' } #' #' # But see_if just returns the values, so you'll see that a lot #' # in the examples: but remember to use assert_that in your code. #' see_if(is.character(x)) #' see_if(length(x) == 3) #' see_if(is.dir(17)) #' see_if(is.dir("asdf")) #' see_if(5 < 3, msg = "Five is not smaller than three") assert_that <- function(..., env = parent.frame(), msg = NULL) { res <- see_if(..., env = env, msg = msg) if (res) return(TRUE) stop(assertError(attr(res, "msg"))) } assertError <- function (message, call = NULL) { class <- c("assertError", "simpleError", "error", "condition") structure(list(message = message, call = call), class = class) } #' @rdname assert_that #' @export see_if <- function(..., env = parent.frame(), msg = NULL) { asserts <- eval(substitute(alist(...))) for (assertion in asserts) { res <- tryCatch({ eval(assertion, env) }, assertError = function(e) { structure(FALSE, msg = e$message) }) check_result(res) # Failed, so figure out message to produce if (!res) { if (is.null(msg)) msg <- get_message(res, assertion, env) return(structure(FALSE, msg = msg)) } } res } check_result <- function(x) { if (!is.logical(x)) stop("assert_that: assertion must return a logical value", call. = FALSE) if (any(is.na(x))) stop("assert_that: missing values present in assertion", call. = FALSE) if (length(x) != 1) { stop("assert_that: length of assertion is not 1", call. = FALSE) } TRUE } get_message <- function(res, call, env = parent.frame()) { stopifnot(is.call(call), length(call) >= 1) if (has_attr(res, "msg")) { return(attr(res, "msg")) } f <- eval(call[[1]], env) if (!is.primitive(f)) call <- match.call(f, call) fname <- deparse(call[[1]]) fail <- on_failure(f) %||% base_fs[[fname]] %||% fail_default fail(call, env) } # The default failure message works in the same way as stopifnot, so you can # continue to use any function that returns a logical value: you just won't # get a friendly error message fail_default <- function(call, env) { call_string <- deparse(call, width.cutoff = 60L) if (length(call_string) > 1L) ch <- paste0(call_string[1L], "...") paste0(call_string, " is not TRUE") } assertthat/R/base-logical.r0000644000176200001440000000142012247645146015352 0ustar liggesusers#' @include base.r NULL base_fs$"&&" <- function(call, env) { lhs <- eval(call[[2]], env) if (!lhs) { get_message(lhs, call[[2]], env) } else { rhs <- eval(call[[3]], env) get_message(rhs, call[[3]], env) } } base_fs$"||" <- function(call, env) { lhs <- eval(call[[2]], env) l_msg <- get_message(lhs, call[[2]], env) rhs <- eval(call[[3]], env) r_msg <- get_message(rhs, call[[3]], env) paste0(l_msg, " or ", r_msg) } base_fs$any <- function(call, env) { paste0("No elements of ", deparse(call[[2]]), " are true") } base_fs$all <- function(call, env) { res <- eval(call[[2]], env) i <- which(!res) if (length(i) > 10) i <- c(i[1:5], "...") paste0("Elements ", paste(i, collapse = ", "), " of ", deparse(call[[2]]), " are not true") } assertthat/R/assertions-file.r0000644000176200001440000000304013072003306016116 0ustar liggesusers#' @include on-failure.r NULL path_is_not <- function(thing, var = "x") { function(call, env) { paste0("Path '", eval(call[[var]], env), "' is not ", thing) } } #' Useful test related to files #' #' @param path a file path to examine #' @name assertions-file #' @examples #' see_if(is.dir(1)) #' #' tmp <- tempfile() #' see_if(file.exists(tmp)) #' see_if(is.dir(tmp)) #' #' writeLines("x", tmp) #' see_if(file.exists(tmp)) #' see_if(is.dir(tmp)) #' see_if(is.writeable(tmp)) #' see_if(is.readable(tmp)) #' unlink(tmp) #' #' see_if(is.readable(tmp)) NULL #' @export #' @rdname assertions-file is.dir <- function(path) { assert_that(is.string(path), file.exists(path)) file.info(path)$isdir } on_failure(is.dir) <- path_is_not("a directory", "path") #' @export #' @rdname assertions-file is.writeable <- function(path) { assert_that(is.string(path), file.exists(path)) file.access(path, mode = 2)[[1]] == 0 } on_failure(is.writeable) <- path_is_not("writeable", "path") #' @export #' @rdname assertions-file is.readable <- function(path) { assert_that(is.string(path), file.exists(path)) file.access(path, mode = 4)[[1]] == 0 } on_failure(is.readable) <- path_is_not("readable", "path") #' @param ext extension to test for (\code{has_extension} only) #' @export #' @rdname assertions-file has_extension <- function(path, ext) { tools::file_ext(path) == ext } on_failure(has_extension) <- function(call, env) { path <- eval(call$path, env) ext <- eval(call$ext, env) paste0("File '", basename(path), "' does not have extension ", ext) } assertthat/R/base-comparison.r0000644000176200001440000000103012247641631016102 0ustar liggesusers#' @include base.r NULL logical_is_not <- function(failed) { function(call, env) { lhs <- paste(deparse(call[[2]]), collapse = "") rhs <- paste(deparse(call[[3]]), collapse = "") paste0(lhs, " not ", failed, " ", rhs) } } base_fs$"==" <- logical_is_not("equal to") base_fs$"<" <- logical_is_not("less than") base_fs$">" <- logical_is_not("greater than") base_fs$">=" <- logical_is_not("greater than or equal to") base_fs$"<=" <- logical_is_not("less than or equal to") base_fs$"!=" <- logical_is_not("not equal to") assertthat/R/utils.r0000644000176200001440000000006212131076757014167 0ustar liggesusers"%||%" <- function(a, b) if (is.null(a)) b else a assertthat/R/assertions-scalar.R0000644000176200001440000000415013072003306016407 0ustar liggesusers#' @include on-failure.r NULL #' Assert input is a scalar. #' #' \code{is.scalar} provides a generic method for checking input is a scalar. #' \code{is.string}, \code{is.flag}, \code{is.number} and \code{is.count} #' provide tests for specific types. #' #' @family assertions #' @param x object to test #' @name scalar #' @aliases NULL NULL #' @rdname scalar #' @export #' @examples #' # Generic check for scalars #' see_if(is.scalar("a")) #' see_if(is.scalar(1:10)) #' is.scalar <- function(x) { length(x) == 1L } on_failure(is.scalar) <- function(call, env) { type <- eval(call$type, env) paste0(deparse(call$x), " is not a scalar.") } #' @rdname scalar #' @export #' @examples #' # string = scalar character vector #' see_if(is.string(1:3)) #' see_if(is.string(c("a", "b"))) #' see_if(is.string("x")) #' is.string <- function(x) is.character(x) && length(x) == 1 on_failure(is.string) <- function(call, env) { paste0(deparse(call$x), " is not a string (a length one character vector).") } #' @rdname scalar #' @export #' @examples #' # number = scalar numeric/integer vector #' see_if(is.number(1:3)) #' see_if(is.number(1.5)) #' is.number <- function(x) is.numeric(x) && length(x) == 1 on_failure(is.number) <- function(call, env) { paste0(deparse(call$x), " is not a number (a length one numeric vector).") } #' @rdname scalar #' @export #' @examples #' # flag = scalar logical vector #' see_if(is.flag(1:3)) #' see_if(is.flag("a")) #' see_if(is.flag(c(FALSE, FALSE, TRUE))) #' see_if(is.flag(FALSE)) #' is.flag <- function(x) is.logical(x) && length(x) == 1 on_failure(is.flag) <- function(call, env) { paste0(deparse(call$x), " is not a flag (a length one logical vector).") } #' @rdname scalar #' @export #' @examples #' # count = scalar positive integer #' see_if(is.count("a")) #' see_if(is.count(-1)) #' see_if(is.count(1:5)) #' see_if(is.count(1.5)) #' see_if(is.count(1)) #' is.count <- function(x) { if (length(x) != 1) return(FALSE) if (!is.integerish(x)) return(FALSE) x > 0 } on_failure(is.count) <- function(call, env) { paste0(deparse(call$x), " is not a count (a single positive integer)") } assertthat/R/on-failure.r0000644000176200001440000000144312247641631015071 0ustar liggesusers#' Custom failure messages for assertions. #' #' @param x a assertion function that returns \code{TRUE} if the assertion #' is met, \code{FALSE} otherwise. #' @param value a function with parameters \code{call} and \code{env} #' that returns a custom error message as a string. #' @export #' @examples #' is_odd <- function(x) { #' assert_that(is.numeric(x), length(x) == 1) #' x %% 2 == 1 #' } #' see_if(is_odd(2)) #' #' on_failure(is_odd) <- function(call, env) { #' paste0(deparse(call$x), " is even") #' } #' see_if(is_odd(2)) on_failure <- function(x) attr(x, "fail") #' @export #' @rdname on_failure #' @usage on_failure(x) <- value "on_failure<-" <- function(x, value) { stopifnot(is.function(x), identical(names(formals(value)), c("call", "env"))) attr(x, "fail") <- value x } assertthat/R/validate-that.R0000644000176200001440000000157013072003306015504 0ustar liggesusers#' Validate that certain conditions are true. #' #' \code{validate_that} is an alternative to the function #' \code{\link{assert_that}}, that returns a \code{character} vector. This #' makes them easier to use within S4 \code{"validate"} methods. #' #' @inheritParams assert_that #' @return A \code{character} vector if the assertion is false, or \code{TRUE} #' if the assertion is true. #' @export #' @seealso \code{\link{assert_that}}, which returns an error if the condition #' is false. #' @examples #' x <- 1 #' # assert_that() generates errors, so can't be usefully run in #' # examples #' validate_that(is.numeric(x)) #' validate_that(is.character(x)) #' validate_that(length(x) == 3) #' validate_that(is.dir("asdf")) validate_that <- function(..., env = parent.frame(), msg = NULL) { res <- see_if(..., env = env, msg = msg) if (res) return(TRUE) return(attr(res, "msg")) } assertthat/R/base-is.r0000644000176200001440000000277112247641631014360 0ustar liggesusers#' @include base.r NULL is_not <- function(thing) { function(call, env) { paste0(deparse(call[[2]]), " is not ", thing) } } # Vectors base_fs$is.atomic <- is_not("an atomic vector") base_fs$is.character <- is_not("a character vector") base_fs$is.complex <- is_not("a complex vector") base_fs$is.double <- is_not("a numeric vector") base_fs$is.integer <- is_not("an integer vector") base_fs$is.numeric <- is_not("a numeric or integer vector") base_fs$is.raw <- is_not("a raw vector") base_fs$is.vector <- is_not("an atomic vector without attributes") # Factors base_fs$is.factor <- is_not("a factor") base_fs$is.ordered <- is_not("an ordered factor") # More complicated data structures base_fs$is.array <- is_not("an array") base_fs$is.data.frame <- is_not("a data frame") base_fs$is.list <- is_not("a list") base_fs$is.matrix <- is_not("a matrix") base_fs$is.null <- is_not("NULL") # Functions and environments base_fs$is.environment <- is_not("an environment") base_fs$is.function <- is_not("a function") base_fs$is.primitive <- is_not("a primitive function") # Computing on the language base_fs$is.call <- is_not("a quoted call") base_fs$is.expression <- is_not("an expression object") base_fs$is.name <- is_not("a name") base_fs$is.pairlist <- is_not("a pairlist") base_fs$is.recursive <- is_not("a recursive object") base_fs$is.symbol <- is_not("a name") # Catch all base_fs$inherits <- function(call, env) { class <- eval(call$what, env) paste0(deparse(call$x), " does not inherit from class ", class) } assertthat/R/base-misc.r0000644000176200001440000000053012247641631014667 0ustar liggesusers#' @include base.r NULL base_fs$file.exists <- function(call, env) { path <- eval(call[[2]], env) paste0("Path '", path, "' does not exist") } base_fs$anyDuplicated <- function(call, env) { paste0(call$x, " is not unique") } base_fs$identical <- function(call, env) { paste0(deparse(call$x), " not identical to ", deparse(call$y)) } assertthat/R/assertions.r0000644000176200001440000001000113072003306015174 0ustar liggesusers#' @include on-failure.r NULL is.integerish <- function(x) { is.integer(x) || (is.numeric(x) && all(x == as.integer(x))) } # is.positive.integer # is.negative.integer # is.positive.double # is.negative.double is.named <- function(x) { nm <- names(x) !is.null(nm) && all(!is.na(nm) & nm != "") } on_failure(is.named) <- function(call, env) { paste0("Not all elements of ", deparse(call$x), " have names.") } #' Has attribute or name? #' #' @param x object to test #' @param which name or attribute #' @export #' @examples #' has_attr(has_attr, "fail") #' x <- 10 #' x %has_attr% "a" #' #' y <- list(a = 1, b = 2) #' see_if(y %has_name% "c") has_attr <- function(x, which) !is.null(attr(x, which, exact = TRUE)) on_failure(has_attr) <- function(call, env) { paste0(deparse(call$x), " does not have attribute ", eval(call$which, env)) } #' @export #' @rdname has_attr "%has_attr%" <- has_attr #' @export #' @rdname has_attr has_name <- function(x, which) which %in% names(x) on_failure(has_name) <- function(call, env) { paste0(deparse(call$x), " does not have name ", eval(call$which, env)) } #' @export #' @rdname has_attr "%has_name%" <- has_name #' Does object contain any missing values? #' #' @family assertions #' @param x object to test #' @export #' @examples #' see_if(noNA("a")) #' see_if(noNA(c(TRUE, NA))) #' x <- sample(c(1:10, NA), 100, rep = TRUE) #' see_if(noNA(x)) noNA <- function(x) { !(any(is.na(x))) } on_failure(noNA) <- function(call, env) { n <- sum(is.na(eval(call$x, env))) paste0(deparse(call$x), " contains ", n, " missing values") } #' Are two objects equal? #' #' @param x,y objects to compare #' @param ... additional arguments passed to \code{\link{all.equal}} #' @family assertions #' @export #' @examples #' x <- 2 #' see_if(are_equal(x, 1.9)) #' see_if(are_equal(x, 1.999, tol = 0.01)) #' see_if(are_equal(x, 2)) are_equal <- function(x, y, ...) { isTRUE(all.equal(x, y, ...)) } on_failure(are_equal) <- function(call, env) { paste0(deparse(call$x), " not equal to ", deparse(call$y)) } #' Missing is functions. #' #' @param x object to test #' @family assertions #' @name assert-is #' @aliases NULL #' @examples #' a <- Sys.time() #' is.time(a) #' b <- Sys.Date() #' is.date(b) #' c <- try(stop("!!")) #' is.error(c) NULL #' @export #' @rdname assert-is is.error <- function(x) inherits(x, "try-error") on_failure(is.error) <- function(call, env) { paste0(deparse(call$x), " is not a try-error") } #' @export #' @rdname assert-is is.time <- function(x) inherits(x, "POSIXt") on_failure(is.time) <- function(call, env) { paste0(deparse(call$x), " is not a POSIXt date-time object") } #' @export #' @rdname assert-is is.date <- function(x) inherits(x, "Date") on_failure(is.date) <- function(call, env) { paste0(deparse(call$x), " is not a Date object") } #' Check a function has specified arguments #' #' @param f a function #' @param args a character vector of argument names #' @param exact if \code{TRUE}, argument names must match \code{args} #' exactly (order and value); otherwise \code{f} just must have at least #' \code{args} in any order #' @export #' @examples #' has_args(mean, "x") #' has_args(mean, "x", exact = TRUE) #' #' see_if(mean %has_args% "x") #' see_if(mean %has_args% "y") has_args <- function(f, args, exact = FALSE) { assert_that(is.function(f)) if (exact) { identical(args, names(formals(f))) } else { all(args %in% names(formals(f))) } } on_failure(has_args) <- function(call, env) { args <- paste(eval(call$args, env), collapse = ", ") paste0("Function " , deparse(call$f), " does not have arguments ", args) } #' @export #' @rdname has_args "%has_args%" <- function(f, args) has_args(f, args) #' Check an object doesn't have any empty dimensions #' #' @param x object to test #' @family assertions #' @export #' @examples #' not_empty(numeric()) #' not_empty(mtcars[0, ]) #' not_empty(mtcars[, 0]) not_empty <- function(x) { all((dim(x) %||% length(x)) != 0) } on_failure(not_empty) <- function(call, env) { paste0(deparse(call$x), " has an empty dimension") } assertthat/README.md0000644000176200001440000000665713072003644013730 0ustar liggesusers# assertthat [![Travis-CI Build Status](https://travis-ci.org/hadley/assertthat.svg?branch=master)](https://travis-ci.org/hadley/assertthat) assertthat provides a drop in replacement for `stopifnot()` that makes it easy to check the pre- and post-conditions of a function, while producing useful error messages. ```R x <- 1:10 stopifnot(is.character(x)) # Error: is.character(x) is not TRUE assert_that(is.character(x)) # Error: x is not a character vector assert_that(length(x) == 5) # Error: length(x) not equal to 5 assert_that(is.numeric(x)) # [1] TRUE ``` This is a good defensive programming technique, and is useful as source-code documentation: you can see exactly what your function expects when you come back to it in the future. It is partly a response to the lack of static typing in R, but it allows you to test for general conditions (like `length(x) == length(y)`) that are difficult to express in a type system. `assertthat` can be installed either from CRAN: ```R install.packages('assertthat') ``` or with devtools: ```R devtools::install_github("hadley/assertthat") ``` ## New assertions As well as all the functions provided by R, assertthat provides a few more that I use a lot: * `is.flag(x)`: is x `TRUE` or `FALSE`? (a boolean flag) * `is.string(x)`: is x a length 1 character vector? * `has_name(x, nm)`, `x %has_name% nm`: does `x` have component `nm`? * `has_attr(x, attr)`, `x %has_attr% attr`: does `x` have attribute `attr`? * `is.count(x)`: is x a single positive integer? * `are_equal(x, y)`: are `x` and `y` equal? * `not_empty(x)`: are all dimensions of `x` greater than 0? * `noNA(x)`: is `x` free from missing values? * `is.dir(path)`: is `path` a directory? * `is.writeable(path)`/`is.readable(path)`: is `path` writeable/readable? * `has_extension(path, extension)`: does `file` have given `extension`? ## `assert_that`, `see_if` and `validate_that` There are three main functions in assertthat: * `assert_that()` signal an error * `see_if()` returns a logical value, with the error message as an attribute. * `validate_that()` returns `TRUE` on success, otherwise returns the error as a string. You'll use `assert_that()` in your own code, but you'll mostly see `see_if()` in the examples (because `R CMD check` requires that examples run without errors). Use `validate_that()` for S4 validate methods. ## Writing your own assertions If you're writing your own assertions, you can provide custom error messages using the `on_failure()` helper: ```R is_odd <- function(x) { assert_that(is.numeric(x), length(x) == 1) x %% 2 == 1 } assert_that(is_odd(2)) # Error: is_odd(x = 2) is not TRUE on_failure(is_odd) <- function(call, env) { paste0(deparse(call$x), " is even") } assert_that(is_odd(2)) # Error: 2 is even ``` The `on_failure` callback is called with two arguments, the unevaluated function `call` (which has already been standardised with `match.call()`), and `env`, and the environment in which the assertion was executed. This allows you to choose between displaying values or names in your error messages. Read the [advanced R book](http://adv-r.had.co.nz/Expressions.html) to learn more about working with calls. Also note the use of `assert_that()` in our new function: assertions flow through function calls ensuring that you get a useful error message at the top level: ```R assert_that(is_odd("b")) # Error: x is not a numeric or integer vector assert_that(is_odd(1:2)) # Error: length(x) not equal to 1 ``` assertthat/MD50000644000176200001440000000307513073245215012753 0ustar liggesusers07a698042f2f9f5ab2218528d2ccb37d *DESCRIPTION bb79293f1ab9e2d571ff3428f2783ac4 *NAMESPACE f4b21e96be18c208d939c7f7e40239b9 *R/assert-that.r c8af5f3dfed9fc81afb7ebd8a4dc8a57 *R/assertions-file.r 154eb9399c030c8713d1550f65ed0ab9 *R/assertions-scalar.R ad16ac5a3ebd217c6d3271d2bcd16207 *R/assertions.r bf48a75f9c36892a64e81da55ede64ed *R/base-comparison.r 6e2ffc34b89617577cd86d68edffa8b7 *R/base-is.r 487ba0225528ba58e80015de661dc6ba *R/base-logical.r f1bfb65dbae725fa7b8047395077266a *R/base-misc.r b7a004bd983209b5a9d2aed114689a1b *R/base.r 9cc3dc154a2ab45e4559600aba559ecc *R/on-failure.r 508577888dc400bb76df829612db84a0 *R/utils.r e706aa5d6a5cd888705e86ff303ea78b *R/validate-that.R d96d8c06fce52277edb9a14501cd4c0a *README.md f5a71fac111703163ed68d02f1e0979f *man/are_equal.Rd 5117a630d5932adf4c66c16e987cd0f2 *man/assert-is.Rd 5d8fa47b8988ebdac0c7fb594d2092ff *man/assert_that.Rd b92b5415b5961f66f95f4ace3b25f073 *man/assertions-file.Rd dc5a3728c016bc6f13b5771ff799c457 *man/has_args.Rd bc27b0b826ab37c6bc46d12266b815ef *man/has_attr.Rd fb36eafcdd7f0484a9eb8fc881b3d8cf *man/noNA.Rd dec5540a428715f1e256b791b144dd84 *man/not_empty.Rd 36fc2fa519ef6b2af0b2a29ba8f0ed76 *man/on_failure.Rd 52e664c380303f85d11cb1e65534e694 *man/scalar.Rd ac5a46b2fbda515a96e1e5455120a5f5 *man/validate_that.Rd ba66accab371620d17856bf99192b710 *tests/testthat.R c88f0213440ffde9b972ce2efebbc743 *tests/testthat/test-assertions.R 94f403145c6ca9bc307d38b154b0c14d *tests/testthat/test-base.R 5bda953b24f68051e5788d8592eae233 *tests/testthat/test-file.R 4217b26332614578760405ab126b09a7 *tests/testthat/test-scalar.R assertthat/DESCRIPTION0000644000176200001440000000160013073245215014141 0ustar liggesusersPackage: assertthat Title: Easy Pre and Post Assertions Version: 0.2.0 Authors@R: person("Hadley", "Wickham", , "hadley@rstudio.com", c("aut", "cre")) Description: assertthat is an extension to stopifnot() that makes it easy to declare the pre and post conditions that you code should satisfy, while also producing friendly error messages so that your users know what they've done wrong. License: GPL-3 Imports: tools Suggests: testthat Collate: 'assert-that.r' 'on-failure.r' 'assertions-file.r' 'assertions-scalar.R' 'assertions.r' 'base.r' 'base-comparison.r' 'base-is.r' 'base-logical.r' 'base-misc.r' 'utils.r' 'validate-that.R' RoxygenNote: 6.0.1 NeedsCompilation: no Packaged: 2017-04-10 19:00:43 UTC; hadley Author: Hadley Wickham [aut, cre] Maintainer: Hadley Wickham Repository: CRAN Date/Publication: 2017-04-11 21:28:45 UTC assertthat/man/0000755000176200001440000000000013072003332013200 5ustar liggesusersassertthat/man/assertions-file.Rd0000644000176200001440000000136313072003332016601 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/assertions-file.r \name{assertions-file} \alias{assertions-file} \alias{is.dir} \alias{is.writeable} \alias{is.readable} \alias{has_extension} \title{Useful test related to files} \usage{ is.dir(path) is.writeable(path) is.readable(path) has_extension(path, ext) } \arguments{ \item{path}{a file path to examine} \item{ext}{extension to test for (\code{has_extension} only)} } \description{ Useful test related to files } \examples{ see_if(is.dir(1)) tmp <- tempfile() see_if(file.exists(tmp)) see_if(is.dir(tmp)) writeLines("x", tmp) see_if(file.exists(tmp)) see_if(is.dir(tmp)) see_if(is.writeable(tmp)) see_if(is.readable(tmp)) unlink(tmp) see_if(is.readable(tmp)) } assertthat/man/assert-is.Rd0000644000176200001440000000103213072003332015375 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/assertions.r \name{assert-is} \alias{is.error} \alias{is.time} \alias{is.date} \title{Missing is functions.} \usage{ is.error(x) is.time(x) is.date(x) } \arguments{ \item{x}{object to test} } \description{ Missing is functions. } \examples{ a <- Sys.time() is.time(a) b <- Sys.Date() is.date(b) c <- try(stop("!!")) is.error(c) } \seealso{ Other assertions: \code{\link{are_equal}}, \code{\link{is.scalar}}, \code{\link{noNA}}, \code{\link{not_empty}} } assertthat/man/on_failure.Rd0000644000176200001440000000136713072003332015621 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/on-failure.r \name{on_failure} \alias{on_failure} \alias{on_failure<-} \title{Custom failure messages for assertions.} \usage{ on_failure(x) on_failure(x) <- value } \arguments{ \item{x}{a assertion function that returns \code{TRUE} if the assertion is met, \code{FALSE} otherwise.} \item{value}{a function with parameters \code{call} and \code{env} that returns a custom error message as a string.} } \description{ Custom failure messages for assertions. } \examples{ is_odd <- function(x) { assert_that(is.numeric(x), length(x) == 1) x \%\% 2 == 1 } see_if(is_odd(2)) on_failure(is_odd) <- function(call, env) { paste0(deparse(call$x), " is even") } see_if(is_odd(2)) } assertthat/man/assert_that.Rd0000644000176200001440000000370213072003332016012 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/assert-that.r \name{assert_that} \alias{assert_that} \alias{see_if} \title{Assert that certain conditions are true.} \usage{ assert_that(..., env = parent.frame(), msg = NULL) see_if(..., env = parent.frame(), msg = NULL) } \arguments{ \item{...}{unnamed expressions that describe the conditions to be tested. Rather than combining expressions with \code{&&}, separate them by commas so that better error messages can be generated.} \item{env}{(advanced use only) the environment in which to evaluate the assertions.} \item{msg}{a custom error message to be printed if one of the conditions is false.} } \description{ \code{assert_that} is a drop-in replacement for \code{\link{stopifnot}} but is designed to give informative error messages. } \section{Assertions}{ Assertion functions should return a single \code{TRUE} or \code{FALSE}: any other result is an error, and \code{assert_that} will complain about it. This will always be the case for the assertions provided by \code{assertthat}, but you may need be a more careful for base R functions. To make your own assertions that work with \code{assert_that}, see the help for \code{\link{on_failure}}. Alternatively, a custom message can be specified for each call. } \examples{ x <- 1 # assert_that() generates errors, so can't be usefully run in # examples \dontrun{ assert_that(is.character(x)) assert_that(length(x) == 3) assert_that(is.dir("asdf")) y <- tempfile() writeLines("", y) assert_that(is.dir(y)) assert_that(FALSE, msg = "Custom error message") } # But see_if just returns the values, so you'll see that a lot # in the examples: but remember to use assert_that in your code. see_if(is.character(x)) see_if(length(x) == 3) see_if(is.dir(17)) see_if(is.dir("asdf")) see_if(5 < 3, msg = "Five is not smaller than three") } \seealso{ \code{\link{validate_that}}, which returns a message (not an error) if the condition is false. } assertthat/man/has_args.Rd0000644000176200001440000000126513072003332015262 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/assertions.r \name{has_args} \alias{has_args} \alias{\%has_args\%} \title{Check a function has specified arguments} \usage{ has_args(f, args, exact = FALSE) f \%has_args\% args } \arguments{ \item{f}{a function} \item{args}{a character vector of argument names} \item{exact}{if \code{TRUE}, argument names must match \code{args} exactly (order and value); otherwise \code{f} just must have at least \code{args} in any order} } \description{ Check a function has specified arguments } \examples{ has_args(mean, "x") has_args(mean, "x", exact = TRUE) see_if(mean \%has_args\% "x") see_if(mean \%has_args\% "y") } assertthat/man/noNA.Rd0000644000176200001440000000101413072003332014316 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/assertions.r \name{noNA} \alias{noNA} \title{Does object contain any missing values?} \usage{ noNA(x) } \arguments{ \item{x}{object to test} } \description{ Does object contain any missing values? } \examples{ see_if(noNA("a")) see_if(noNA(c(TRUE, NA))) x <- sample(c(1:10, NA), 100, rep = TRUE) see_if(noNA(x)) } \seealso{ Other assertions: \code{\link{are_equal}}, \code{\link{is.error}}, \code{\link{is.scalar}}, \code{\link{not_empty}} } assertthat/man/not_empty.Rd0000644000176200001440000000100713072003332015503 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/assertions.r \name{not_empty} \alias{not_empty} \title{Check an object doesn't have any empty dimensions} \usage{ not_empty(x) } \arguments{ \item{x}{object to test} } \description{ Check an object doesn't have any empty dimensions } \examples{ not_empty(numeric()) not_empty(mtcars[0, ]) not_empty(mtcars[, 0]) } \seealso{ Other assertions: \code{\link{are_equal}}, \code{\link{is.error}}, \code{\link{is.scalar}}, \code{\link{noNA}} } assertthat/man/has_attr.Rd0000644000176200001440000000103113072003332015267 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/assertions.r \name{has_attr} \alias{has_attr} \alias{\%has_attr\%} \alias{has_name} \alias{\%has_name\%} \title{Has attribute or name?} \usage{ has_attr(x, which) x \%has_attr\% which has_name(x, which) x \%has_name\% which } \arguments{ \item{x}{object to test} \item{which}{name or attribute} } \description{ Has attribute or name? } \examples{ has_attr(has_attr, "fail") x <- 10 x \%has_attr\% "a" y <- list(a = 1, b = 2) see_if(y \%has_name\% "c") } assertthat/man/scalar.Rd0000644000176200001440000000232713072003332014740 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/assertions-scalar.R \name{scalar} \alias{is.scalar} \alias{is.string} \alias{is.number} \alias{is.flag} \alias{is.count} \title{Assert input is a scalar.} \usage{ is.scalar(x) is.string(x) is.number(x) is.flag(x) is.count(x) } \arguments{ \item{x}{object to test} } \description{ \code{is.scalar} provides a generic method for checking input is a scalar. \code{is.string}, \code{is.flag}, \code{is.number} and \code{is.count} provide tests for specific types. } \examples{ # Generic check for scalars see_if(is.scalar("a")) see_if(is.scalar(1:10)) # string = scalar character vector see_if(is.string(1:3)) see_if(is.string(c("a", "b"))) see_if(is.string("x")) # number = scalar numeric/integer vector see_if(is.number(1:3)) see_if(is.number(1.5)) # flag = scalar logical vector see_if(is.flag(1:3)) see_if(is.flag("a")) see_if(is.flag(c(FALSE, FALSE, TRUE))) see_if(is.flag(FALSE)) # count = scalar positive integer see_if(is.count("a")) see_if(is.count(-1)) see_if(is.count(1:5)) see_if(is.count(1.5)) see_if(is.count(1)) } \seealso{ Other assertions: \code{\link{are_equal}}, \code{\link{is.error}}, \code{\link{noNA}}, \code{\link{not_empty}} } assertthat/man/are_equal.Rd0000644000176200001440000000110213072003332015417 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/assertions.r \name{are_equal} \alias{are_equal} \title{Are two objects equal?} \usage{ are_equal(x, y, ...) } \arguments{ \item{x, y}{objects to compare} \item{...}{additional arguments passed to \code{\link{all.equal}}} } \description{ Are two objects equal? } \examples{ x <- 2 see_if(are_equal(x, 1.9)) see_if(are_equal(x, 1.999, tol = 0.01)) see_if(are_equal(x, 2)) } \seealso{ Other assertions: \code{\link{is.error}}, \code{\link{is.scalar}}, \code{\link{noNA}}, \code{\link{not_empty}} } assertthat/man/validate_that.Rd0000644000176200001440000000233413072003332016302 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/validate-that.R \name{validate_that} \alias{validate_that} \title{Validate that certain conditions are true.} \usage{ validate_that(..., env = parent.frame(), msg = NULL) } \arguments{ \item{...}{unnamed expressions that describe the conditions to be tested. Rather than combining expressions with \code{&&}, separate them by commas so that better error messages can be generated.} \item{env}{(advanced use only) the environment in which to evaluate the assertions.} \item{msg}{a custom error message to be printed if one of the conditions is false.} } \value{ A \code{character} vector if the assertion is false, or \code{TRUE} if the assertion is true. } \description{ \code{validate_that} is an alternative to the function \code{\link{assert_that}}, that returns a \code{character} vector. This makes them easier to use within S4 \code{"validate"} methods. } \examples{ x <- 1 # assert_that() generates errors, so can't be usefully run in # examples validate_that(is.numeric(x)) validate_that(is.character(x)) validate_that(length(x) == 3) validate_that(is.dir("asdf")) } \seealso{ \code{\link{assert_that}}, which returns an error if the condition is false. }