assertthat/0000755000176200001440000000000012250210556012432 5ustar liggesusersassertthat/inst/0000755000176200001440000000000012250126504013406 5ustar liggesusersassertthat/inst/tests/0000755000176200001440000000000012247644747014574 5ustar liggesusersassertthat/inst/tests/test-base.R0000644000176200001440000000062412247645216016600 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") })assertthat/tests/0000755000176200001440000000000012250145015013571 5ustar liggesusersassertthat/tests/test-that.R0000644000176200001440000000010212250126511015622 0ustar liggesuserslibrary(testthat) library(assertthat) test_package("assertthat") assertthat/NAMESPACE0000644000176200001440000000076712247641766013704 0ustar liggesusersexport("%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) importFrom(tools,file_ext) assertthat/R/0000755000176200001440000000000012247641636012650 5ustar liggesusersassertthat/R/base.r0000644000176200001440000000005012247641636013740 0ustar liggesusersbase_fs <- new.env(parent = emptyenv()) assertthat/R/assert-that.r0000644000176200001440000000662012247640053015266 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}}. #' #' @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. #' @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)) #' } #' #' # 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")) assert_that <- function(..., env = parent.frame()) { res <- see_if(..., env = env) 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()) { 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) { 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: assertion has length greater than 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.r0000644000176200001440000000306612131270226016130 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) #' @importFrom tools file_ext #' @export #' @rdname assertions-file has_extension <- function(path, ext) { 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.R0000644000176200001440000000415612247641757016442 0ustar liggesusers#' @include on-failure.r NULL #' Assert input is a scalar. #' #' \code{is.scala} 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 numeric/integer 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 #' # flag = 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.R0000644000176200001440000000154112247641737015525 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()) { res <- see_if(..., env = env) 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.r0000644000176200001440000000776212247642063015234 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(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.md0000644000176200001440000000641712247646074013737 0ustar liggesusers# 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 allow you to test for general conditions (like `length(x) == length(y)`) that are difficult to express in a type system. `assertthat` is not yet available on CRAN, but you can install it 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 two 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/MD50000644000176200001440000000257312250210556012751 0ustar liggesusers9d6f40f50ee12be47c061798a93f54a5 *DESCRIPTION da16c2e00f9ad6320ca55102ff2bf900 *NAMESPACE 6700dc426204d6942aa9493d0f401117 *R/assert-that.r b8a27b28dc330772b389b29bd6156223 *R/assertions-file.r 8c016508a2d5a00f76f4ed1d223dfdce *R/assertions-scalar.R bccfd0f930aaade21d8d00131d2b2ae0 *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 62a6c70097ecd53a7310d075f5e75af9 *R/validate-that.R 329bb56c75acb8f016930e2336561ef4 *README.md 244be8591c9bcb1db2b93fe31765cfa7 *inst/tests/test-base.R e1e12ba1c980e7a84fdad54afc887fd4 *man/are_equal.Rd 01cabba4b12491e922e28d58010f243e *man/assert-is.Rd 0b47ef2a6e237434dbc088882509ac4c *man/assert_that.Rd 49ca9ea5566be9987e984ae6314a6ded *man/assertions-file.Rd afc97d9fcf61f05dbed9e913cb1e8e40 *man/has_args.Rd f461c5adf9380d3030c9e7eb501bff7a *man/has_attr.Rd d4d7bc3089e43441b77818008030a86b *man/noNA.Rd 8265167687eda318bb5c6d373468b489 *man/not_empty.Rd 1fdd3413c40ab336f4cd542cb6b847e6 *man/on_failure.Rd 54f2544b2af67f8f28395acd0af92389 *man/scalar.Rd efd55dea4588c4cb5d4da880bad7ca5f *man/validate_that.Rd cfa4c85c1d568b55795575389e2f0ef4 *tests/test-that.R assertthat/DESCRIPTION0000644000176200001440000000154312250210556014143 0ustar liggesusersPackage: assertthat Title: Easy pre and post assertions. Version: 0.1 Authors@R: 'Hadley Wickham [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 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' Roxygen: list(wrap = FALSE) Packaged: 2013-12-05 18:46:37 UTC; hadley Author: 'Hadley Wickham' [aut, cre] Maintainer: 'Hadley Wickham' NeedsCompilation: no Repository: CRAN Date/Publication: 2013-12-06 00:51:10 assertthat/man/0000755000176200001440000000000012247640060013210 5ustar liggesusersassertthat/man/assertions-file.Rd0000644000176200001440000000123212247635714016616 0ustar liggesusers\name{assertions-file} \alias{assertions-file} \alias{has_extension} \alias{is.dir} \alias{is.readable} \alias{is.writeable} \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.Rd0000644000176200001440000000104712247643304015417 0ustar liggesusers\name{assert-is} \alias{is.date} \alias{is.error} \alias{is.time} \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.count}}, \code{\link{is.flag}}, \code{\link{is.number}}, \code{\link{is.scalar}}, \code{\link{is.string}}; \code{\link{noNA}}; \code{\link{not_empty}} } assertthat/man/on_failure.Rd0000644000176200001440000000124712247635714015640 0ustar liggesusers\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.Rd0000644000176200001440000000315612247640060016025 0ustar liggesusers\name{assert_that} \alias{assert_that} \alias{see_if} \title{Assert that certain conditions are true.} \usage{ assert_that(..., env = parent.frame()) see_if(..., env = parent.frame()) } \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.} } \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}}. } \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)) } # 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")) } \seealso{ \code{\link{validate_that}}, which returns a message (not an error) if the condition is false. } assertthat/man/has_args.Rd0000644000176200001440000000114512247635714015301 0ustar liggesusers\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.Rd0000644000176200001440000000111112247643304014330 0ustar liggesusers\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.count}}, \code{\link{is.flag}}, \code{\link{is.number}}, \code{\link{is.scalar}}, \code{\link{is.string}}; \code{\link{is.date}}, \code{\link{is.error}}, \code{\link{is.time}}; \code{\link{not_empty}} } assertthat/man/not_empty.Rd0000644000176200001440000000110412247643304015515 0ustar liggesusers\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.count}}, \code{\link{is.flag}}, \code{\link{is.number}}, \code{\link{is.scalar}}, \code{\link{is.string}}; \code{\link{is.date}}, \code{\link{is.error}}, \code{\link{is.time}}; \code{\link{noNA}} } assertthat/man/has_attr.Rd0000644000176200001440000000070312247635714015316 0ustar liggesusers\name{has_attr} \alias{\%has_attr\%} \alias{\%has_name\%} \alias{has_attr} \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.Rd0000644000176200001440000000225112247643304014750 0ustar liggesusers\name{scalar} \alias{is.count} \alias{is.flag} \alias{is.number} \alias{is.scalar} \alias{is.string} \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.scala} 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 numeric/integer 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)) # flag = 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.date}}, \code{\link{is.error}}, \code{\link{is.time}}; \code{\link{noNA}}; \code{\link{not_empty}} } assertthat/man/are_equal.Rd0000644000176200001440000000120212247643304015434 0ustar liggesusers\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.count}}, \code{\link{is.flag}}, \code{\link{is.number}}, \code{\link{is.scalar}}, \code{\link{is.string}}; \code{\link{is.date}}, \code{\link{is.error}}, \code{\link{is.time}}; \code{\link{noNA}}; \code{\link{not_empty}} } assertthat/man/validate_that.Rd0000644000176200001440000000205312247641766016326 0ustar liggesusers\name{validate_that} \alias{validate_that} \title{Validate that certain conditions are true.} \usage{ validate_that(..., env = parent.frame()) } \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.} } \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. }