From a47444a290778e405095f0b24aa0af84d6310756 Mon Sep 17 00:00:00 2001 From: WillForan Date: Fri, 22 Jul 2022 12:41:40 -0400 Subject: [PATCH 1/3] qassertm: qassert for many at once (#115) --- R/qassertm.R | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) create mode 100644 R/qassertm.R diff --git a/R/qassertm.R b/R/qassertm.R new file mode 100644 index 00000000..00a4014b --- /dev/null +++ b/R/qassertm.R @@ -0,0 +1,25 @@ +#' @title Quick checks for multiple variable=rule enumerated as arguments +#' +#' @description +#' Ergonomic wraper for \code{\link{qassert}} to check multiple variable=rule pairs +#' +#' @param ... [\code{var.name}=[\code{character}]]\cr +#' Any number of named arguments like var.name=rule\cr +#' See details of \code{\link{qtest}} for rule explanation. +#' @template var.name +#' @return See \code{\link{qassert}}. +#' @seealso \code{\link{qtest}}, \code{\link{qassert}} +#' @useDynLib checkmate +#' @export +#' @examples +#' x=1:10; y=TRUE +#' qassertm(x="i+", y="b") +#' +#' with(data.frame(a=1:26,b=letters), qassertm(a="i+", b="s")) +qassertm <- function(...) { + in_args <- list(...) + for (v in names(in_args)) + eval(substitute(qassert(x, spec), + list(x=as.name(v), spec=in_args[[v]])), + envir=parent.frame()) +} From 9241becdf4f46afbe08af79a317a1e4e948ec73d Mon Sep 17 00:00:00 2001 From: WillForan Date: Fri, 22 Jul 2022 13:11:24 -0400 Subject: [PATCH 2/3] test_qassertm: test multiple asserts --- tests/testthat/test_qassertm.R | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) create mode 100644 tests/testthat/test_qassertm.R diff --git a/tests/testthat/test_qassertm.R b/tests/testthat/test_qassertm.R new file mode 100644 index 00000000..1cb8a8ee --- /dev/null +++ b/tests/testthat/test_qassertm.R @@ -0,0 +1,25 @@ +context("qassertm") + +xb = logical(10) +xi = integer(10) +xr = double(10) + +test_that("fail on any, report first", { + # none + expect_error(qassertm(), NA) + # one + expect_error(qassertm(xb="b"), NA) + # many + expect_error(qassertm(xb="l"), + regexp = "'xb' .*'list', not 'logical'") + + expect_error(qassertm(xb="b", xi="i", xr="r"), NA) + expect_error(qassertm(xb="b", xi="l", xr="r"), + regexp = "'xi' .*'list', not 'integer'") + expect_error(qassertm(xb="b", xi="i", xr="b"), + regexp = "'xr' .*logical', not 'double'") + + # two wrong. only reports first + expect_error(qassertm(xb="b", xi="l", xr="b"), + regexp = "'xi' .*'list', not 'integer'") +}) From e7b8747bb988ce15d0e7c0343c2d76410e2b4319 Mon Sep 17 00:00:00 2001 From: WillForan Date: Sat, 23 Jul 2022 10:54:51 -0400 Subject: [PATCH 3/3] qassert_all: one rule, many vars. actually address #115 --- R/qassertm.R | 39 +++++++++++++++++++++++++++++----- tests/testthat/test_qassertm.R | 19 ++++++++++++++++- 2 files changed, 52 insertions(+), 6 deletions(-) diff --git a/R/qassertm.R b/R/qassertm.R index 00a4014b..ddc98b63 100644 --- a/R/qassertm.R +++ b/R/qassertm.R @@ -1,3 +1,7 @@ +mkqassert <- function(varname, rule, frame) + eval(substitute(qassert(x, spec), list(x=as.name(varname), spec=rule)), + envir=frame) + #' @title Quick checks for multiple variable=rule enumerated as arguments #' #' @description @@ -9,7 +13,6 @@ #' @template var.name #' @return See \code{\link{qassert}}. #' @seealso \code{\link{qtest}}, \code{\link{qassert}} -#' @useDynLib checkmate #' @export #' @examples #' x=1:10; y=TRUE @@ -18,8 +21,34 @@ #' with(data.frame(a=1:26,b=letters), qassertm(a="i+", b="s")) qassertm <- function(...) { in_args <- list(...) - for (v in names(in_args)) - eval(substitute(qassert(x, spec), - list(x=as.name(v), spec=in_args[[v]])), - envir=parent.frame()) + for (v in names(in_args)) mkqassert(v, in_args[[v]], parent.frame()) +} + +#' @title Check single rule against all or enumerated variables +#' +#' @description +#' Ergonomic wraper for \code{\link{qassert}} to check multiple variables against a single rule +#' +#' @param rule [[\code{character}]]\cr +#' Any number of named arguments like var.name=rule\cr +#' See details of \code{\link{qtest}} for rule explanation. +#' @param ... [[\code{var.name}]]\cr +#' list of unquoted variables that should match \code{rule} +#' if none provided, uses all variables in local scope +#' @return See \code{\link{qassert}}. +#' @seealso \code{\link{qassertm}} +#' @export +#' @examples +#' x <- TRUE; y <- FALSE +#' # check all variables, scoped inside function +#' foofunc <- function(x, y) { qassert_all('n'); print(x); } +#' foofunc(1, 2) +#' # only enumerated variables +#' qassert_all('l', x, y) +#' +qassert_all <- function(rule, ...) { + qassert(rule,'s') + varlist <- lapply(match.call(expand.dots = FALSE)$..., as.character) + if(length(varlist)==0L) varlist <- ls(envir=parent.frame()) + for (v in varlist) mkqassert(v, rule, parent.frame()) } diff --git a/tests/testthat/test_qassertm.R b/tests/testthat/test_qassertm.R index 1cb8a8ee..b188c33e 100644 --- a/tests/testthat/test_qassertm.R +++ b/tests/testthat/test_qassertm.R @@ -1,10 +1,11 @@ context("qassertm") xb = logical(10) +xb2 = logical(10) xi = integer(10) xr = double(10) -test_that("fail on any, report first", { +test_that("qassertm: fail on any, report first", { # none expect_error(qassertm(), NA) # one @@ -23,3 +24,19 @@ test_that("fail on any, report first", { expect_error(qassertm(xb="b", xi="l", xr="b"), regexp = "'xi' .*'list', not 'integer'") }) + +test_that("qassert_all", { + # global + expect_error(qassert_all('b',xb,xb2), NA) + expect_error(qassert_all('n',xb,xb2), + regexp="'xb' .*numeric', not 'logical'") + expect_error(qassert_all('r',xr,xb), + regexp="'xb' .*double', not 'logical'") + + # within function. reusing gobal names to test scope + expect_error((function(xb,xb2) qassert_all("n"))(1,2), NA) + expect_error((function(xb,xb2) qassert_all("n"))(1,TRUE), + regexp="'xb2' .*numeric', not 'logical'") + expect_error((function(xb,xb2) qassert_all("n"))(1), + regexp='"xb2" is missing') +})