Another possible shortcut definition:
assert <- function(exprs)
do.call("stopifnot", list(exprs = substitute(exprs), local =
parent.frame()))
After thinking again, I propose to use
??? ? ? stop(simpleError(msg, call = if(p <- sys.parent()) sys.call(p)))
- It seems that the call is the call of the frame where stopifnot(...) is
evaluated. Because that is the correct context, I think it is good.
- It is simpler and also works for call that originally comes from
stopifnot(exprs=*) .
- It allows shortcut ('assert') to have the same call in error message
as stopifnot(exprs=*) .
Another thing: Is it intended that
do.call("stopifnot", list(exprs = expression()))
evaluates each element of the expression object? If so, maybe add a case for
'cl', like
??? ? ? else if(is.expression(exprs))
??? ??? as.call(c(quote(expression), exprs))
--------------------------------------------
On Mon, 4/3/19, Martin Maechler <maechler at stat.math.ethz.ch> wrote:
Subject: Re: [Rd] stopifnot
Cc: r-devel at r-project.org
Date: Monday, 4 March, 2019, 4:59 PM
>>>>> Suharto Anggono Suharto Anggono via R-devel
>>>>>? ? on Sat, 2 Mar 2019 08:28:23 +0000 writes:
>>>>> Suharto Anggono Suharto Anggono via R-devel
>>>>>? ? on Sat, 2 Mar 2019 08:28:23 +0000 writes:
? ? > A private reply by Martin made me realize that I was wrong about
? ? > stopifnot(exprs=TRUE) .
? ? > It actually works fine. I apologize. What I tried and was failed was
? ? > stopifnot(exprs=T) .
? ? > Error in exprs[[1]] : object of type 'symbol' is not
subsettable
indeed! .. and your patch below does address that, too.
? ? > The shortcut
? ? > assert <- function(exprs) stopifnot(exprs = exprs)
? ? > mentioned in "Warning" section of the documentation similarly
fails when called, for example
? ? > assert({})
? ? > About shortcut, a definition that rather works:
? ? > assert <- function(exprs) eval.parent(substitute(stopifnot(exprs =
exprs)))
Interesting... thank you for the suggestion!? I plan to add it
to the help page and then use it a bit .. before considering more.
? ? > Looking at https://stat.ethz.ch/pipermail/r-devel/2017-May/074227.html
, using sys.parent() may be not good. For example, in
? ? > f <- function() stopifnot(exprs={FALSE}, local=FALSE); f()
I'm glad you found this too.. I did have "uneasy feelings" about
using sys.parent(2) to find the correct call ..? and I'm still
not 100% sure about the smart computation of 'n' for
sys.call(n-1) ... but I agree we should move in that direction
as it is so much faster than using withCallingHandlers() + tryCatch()
for all the expressions.
In my tests your revised patch (including the simplificationn
you sent 4 hours later) seems good and indeed does have very
good timing in simple experiments.
It will lead to some error messages being changed,
but in the examples I've seen,? the few changes were acceptable
(sometimes slightly less helpful, sometimes easier to read).
Martin
? ? > A revised patch (also with simpler 'cl'):
? ? > --- stop.R? ? 2019-02-27 16:15:45.324167577 +0000
? ? > +++ stop_new.R? ? 2019-03-02 06:21:35.919471080 +0000
? ? > @@ -1,7 +1,7 @@
? ? > #? File src/library/base/R/stop.R
? ? > #? Part of the R package, https://www.R-project.org
? ? > #
? ? > -#? Copyright (C) 1995-2018 The R Core Team
? ? > +#? Copyright (C) 1995-2019 The R Core Team
? ? > #
? ? > #? This program is free software; you can redistribute it and/or modify
? ? > #? it under the terms of the GNU General Public License as published by
? ? > @@ -33,25 +33,28 @@
? ? > stopifnot <- function(..., exprs, local = TRUE)
? ? > {
? ? > +? ? n <- ...length()
? ? > missE <- missing(exprs)
? ? > -? ? cl <-
? ? > if(missE) {? ## use '...' instead of exprs
? ? > -? ? ? ? match.call(expand.dots=FALSE)$...
? ? > } else {
? ? > -? ? ? ? if(...length())
? ? > +? ? ? ? if(n)
? ? > stop("Must use 'exprs' or unnamed expressions, but not
both")
? ? > envir <- if (isTRUE(local)) parent.frame()
? ? > else if(isFALSE(local)) .GlobalEnv
? ? > else if (is.environment(local)) local
? ? > else stop("'local' must be TRUE, FALSE or an
environment")
? ? > exprs <- substitute(exprs) # protect from evaluation
? ? > -? ? ? ? E1 <- exprs[[1]]
? ? > +? ? ? ? E1 <- if(is.call(exprs)) exprs[[1]]
? ? > +? ? ? ? cl <-
? ? > if(identical(quote(`{`), E1)) # { ... }
? ? > -? ? ? ? do.call(expression, as.list(exprs[-1]))
? ? > +? ? ? ? exprs
? ? > else if(identical(quote(expression), E1))
? ? > -? ? ? ? eval(exprs, envir=envir)
? ? > +? ? ? ? exprs
? ? > else
? ? > -? ? ? ? as.expression(exprs) # or fail ..
? ? > +? ? ? ? call("expression", exprs) # or fail ..
? ? > +? ? ? ? if(!is.null(names(cl))) names(cl) <- NULL
? ? > +? ? ? ? cl[[1]] <- sys.call()[[1]]
? ? > +? ? ? ? return(eval(cl, envir=envir))
? ? > }
? ? > Dparse <- function(call, cutoff = 60L) {
? ? > ch <- deparse(call, width.cutoff = cutoff)
? ? > @@ -62,14 +65,10 @@
? ? > abbrev <- function(ae, n = 3L)
? ? > paste(c(head(ae, n), if(length(ae) > n) "...."),
collapse="\n? ")
? ? > ##
? ? > -? ? for (i in seq_along(cl)) {
? ? > -? ? cl.i <- cl[[i]]
? ? > -? ? ## r <- eval(cl.i, ..)? # with correct warn/err messages:
? ? > -? ? r <- withCallingHandlers(
? ? > -? ? ? ? tryCatch(if(missE) ...elt(i) else eval(cl.i, envir=envir),
? ? > -? ? ? ? ? ? error = function(e) { e$call <- cl.i; stop(e) }),
? ? > -? ? ? ? warning = function(w) { w$call <- cl.i; w })
? ? > +? ? for (i in seq_len(n)) {
? ? > +? ? r <- ...elt(i)
? ? > if (!(is.logical(r) && !anyNA(r) && all(r))) {
? ? > +? ? ? ? cl.i <- match.call(expand.dots=FALSE)$...[[i]]
? ? > msg <- ## special case for decently written 'all.equal(*)':
? ? > if(is.call(cl.i) && identical(cl.i[[1]], quote(all.equal))
&&
? ? > (is.null(ni <- names(cl.i)) || length(cl.i) == 3L ||
? ? > @@ -84,7 +83,12 @@
? ? > "%s are not all TRUE"),
? ? > Dparse(cl.i))
? ? > -? ? ? ? stop(simpleError(msg, call = sys.call(-1)))
? ? > +? ? ? ? n <- sys.nframe()
? ? > +? ? ? ? if((p <- n-3) > 0 &&
? ? > +? ? ? ? ? identical(sys.function(p), sys.function(n)) &&
? ? > +? ? ? ? ? eval(expression(!missE), p)) # originally stopifnot(exprs=*)
? ? > +? ? ? ? n <- p
? ? > +? ? ? ? stop(simpleError(msg, call = if(n > 1) sys.call(n-1)))
? ? > }
? ? > }
? ? > invisible()
? ? > --------------------------------------------
? ? > On Fri, 1/3/19, Martin Maechler <maechler at stat.math.ethz.ch>
wrote:
? ? > Subject: Re: [Rd] stopifnot
? ? > Cc: "Martin Maechler" <maechler at stat.math.ethz.ch>,
r-devel at r-project.org
? ? > Date: Friday, 1 March, 2019, 6:40 PM
>>>>> Suharto Anggono Suharto Anggono
? ? >>>>>>? ?? on Wed, 27 Feb 2019 22:46:04 +0000 writes:
? ? > [...]
? ? >? ?? > Another thing: currently,
? ? >? ?? > stopifnot(exprs=TRUE)
? ? >? ?? > fails.
[[elided Yahoo spam]]
? ? > I've started to carefully test and try the interesting nice
? ? > patch you've provided below.
? ? > [...]
? ? > Martin
? ? >? ?? > A patch:
? ? >? ?? > --- stop.R? ? 2019-02-27 16:15:45.324167577 +0000
? ? >? ?? > +++ stop_new.R? ? 2019-02-27 16:22:15.936203541 +0000
? ? >? ?? > @@ -1,7 +1,7 @@
? ? >? ?? > #? File src/library/base/R/stop.R
? ? >? ?? > #? Part of the R package, https://www.R-project.org
? ? >? ?? > #
? ? >? ?? > -#? Copyright (C) 1995-2018 The R Core Team
? ? >? ?? > +#? Copyright (C) 1995-2019 The R Core Team
? ? >? ?? > #
? ? >? ?? > #? This program is free software; you can redistribute it
and/or modify
? ? >? ?? > #? it under the terms of the GNU General Public License as
published by
? ? >? ?? > @@ -33,25 +33,27 @@
? ? >? ?? > stopifnot <- function(..., exprs, local = TRUE)
? ? >? ?? > {
? ? >? ?? > +? ? n <- ...length()
? ? >? ?? > missE <- missing(exprs)
? ? >? ?? > -? ? cl <-
? ? >? ?? > if(missE) {? ## use '...' instead of exprs
? ? >? ?? > -? ? ? ? match.call(expand.dots=FALSE)$...
? ? >? ?? > } else {
? ? >? ?? > -? ? ? ? if(...length())
? ? >? ?? > +? ? ? ? if(n)
? ? >? ?? > stop("Must use 'exprs' or unnamed expressions,
but not both")
? ? >? ?? > envir <- if (isTRUE(local)) parent.frame()
? ? >? ?? > else if(isFALSE(local)) .GlobalEnv
? ? >? ?? > else if (is.environment(local)) local
? ? >? ?? > else stop("'local' must be TRUE, FALSE or an
environment")
? ? >? ?? > exprs <- substitute(exprs) # protect from evaluation
? ? >? ?? > -? ? ? ? E1 <- exprs[[1]]
? ? >? ?? > +? ? ? ? E1 <- if(is.call(exprs)) exprs[[1]]
? ? >? ?? > +? ? ? ? cl <-
? ? >? ?? > if(identical(quote(`{`), E1)) # { ... }
? ? >? ?? > -? ? ? ? do.call(expression, as.list(exprs[-1]))
? ? >? ?? > +? ? ? ? exprs[-1]
? ? >? ?? > else if(identical(quote(expression), E1))
? ? >? ?? > eval(exprs, envir=envir)
? ? >? ?? > else
? ? >? ?? > as.expression(exprs) # or fail ..
? ? >? ?? > +? ? ? ? if(!is.null(names(cl))) names(cl) <- NULL
? ? >? ?? > +? ? ? ? return(eval(as.call(c(sys.call()[[1]], as.list(cl))),
envir=envir))
? ? >? ?? > }
? ? >? ?? > Dparse <- function(call, cutoff = 60L) {
? ? >? ?? > ch <- deparse(call, width.cutoff = cutoff)
? ? >? ?? > @@ -62,14 +64,10 @@
? ? >? ?? > abbrev <- function(ae, n = 3L)
? ? >? ?? > paste(c(head(ae, n), if(length(ae) > n) "...."),
collapse="\n? ")
? ? >? ?? > ##
? ? >? ?? > -? ? for (i in seq_along(cl)) {
? ? >? ?? > -? ? cl.i <- cl[[i]]
? ? >? ?? > -? ? ## r <- eval(cl.i, ..)? # with correct warn/err
messages:
? ? >? ?? > -? ? r <- withCallingHandlers(
? ? >? ?? > -? ? ? ? tryCatch(if(missE) ...elt(i) else eval(cl.i,
envir=envir),
? ? >? ?? > -? ? ? ? ? ? error = function(e) { e$call <- cl.i; stop(e)
}),
? ? >? ?? > -? ? ? ? warning = function(w) { w$call <- cl.i; w })
? ? >? ?? > +? ? for (i in seq_len(n)) {
? ? >? ?? > +? ? r <- ...elt(i)
? ? >? ?? > if (!(is.logical(r) && !anyNA(r) && all(r))) {
? ? >? ?? > +? ? ? ? cl.i <- match.call(expand.dots=FALSE)$...[[i]]
? ? >? ?? > msg <- ## special case for decently written
'all.equal(*)':
? ? >? ?? > if(is.call(cl.i) && identical(cl.i[[1]],
quote(all.equal)) &&
? ? >? ?? > (is.null(ni <- names(cl.i)) || length(cl.i) == 3L ||
? ? >? ?? > @@ -84,7 +82,11 @@
? ? >? ?? > "%s are not all TRUE"),
? ? >? ?? > Dparse(cl.i))
? ? >? ?? > -? ? ? ? stop(simpleError(msg, call = sys.call(-1)))
? ? >? ?? > +? ? ? ? p <- sys.parent()
? ? >? ?? > +? ? ? ? if(p && identical(sys.function(p), stopifnot)
&&
? ? >? ?? > +? ? ? ? ? !eval(expression(missE), p)) # originally
stopifnot(exprs=*)
? ? >? ?? > +? ? ? ? p <- sys.parent(2)
? ? >? ?? > +? ? ? ? stop(simpleError(msg, call = if(p) sys.call(p)))
? ? >? ?? > }
? ? >? ?? > }
? ? >? ?? > invisible()
? ? > ______________________________________________
? ? > R-devel at r-project.org mailing list
? ? > https://stat.ethz.ch/mailman/listinfo/r-devel
>>>>> Suharto Anggono Suharto Anggono >>>>> on Tue, 5 Mar 2019 17:29:20 +0000 writes:> Another possible shortcut definition: > assert <- function(exprs) > do.call("stopifnot", list(exprs = substitute(exprs), local = parent.frame())) Thank you. I think this is mostly a matter of taste, but I liked your version using eval() & substitute() a bit more. For me, do.call() is a heavy hammer I only like to use when needed.. Or would there be advantages of this version? Indeed (as you note below) one important consideration is the exact message that is produced when one assertion fails. > After thinking again, I propose to use > ??? ? ? stop(simpleError(msg, call = if(p <- sys.parent()) sys.call(p))) That would of course be considerably simpler indeed, part "2 a" of these: > - It seems that the call is the call of the frame where stopifnot(...) is evaluated. Because that is the correct context, I think it is good. > - It is simpler and also works for call that originally comes from stopifnot(exprs=*) . > - It allows shortcut ('assert') to have the same call in error message as stopifnot(exprs=*) . That may be another good reason in addition to code simplicity. I will have to see if this extra simplification does not loose more than I'd want. > Another thing: Is it intended that > do.call("stopifnot", list(exprs = expression())) > evaluates each element of the expression object? ?? I really don't know. Even though such a case looks "unusual" (to say the least), in principle I'd like that expressions are evaluated sequentially until the first non-TRUE result. With a concrete example, I do like what we have currently in unchanged R-devel, but also in R 3.5.x, i.e., in the following, not any "NOT GOOD" should pop up:> stopifnot(exprs = expression(1==1, 2 < 1, stop("NOT GOOD!\n")))Error: 2 < 1 is not TRUE> do.call(stopifnot, list(exprs = expression(1==1, 2 < 1, stop("NOT GOOD!\n"))))Error in do.call(stopifnot, list(exprs = expression(1 == 1, 2 < 1, cat("NOT GOOD!\n")))) : 2 < 1 is not TRUE>Hmm, it seems I do not understand what you ask above in your "Another thing: .." > If so, maybe add a case for 'cl', like > ??? ? ? else if(is.expression(exprs)) > ??? ??? as.call(c(quote(expression), exprs)) that seems simple indeed, but at the moment, I cannot see one example where it makes a difference ... or then I'm "blind" .. ??? Best, Martin > -------------------------------------------- > On Mon, 4/3/19, Martin Maechler <maechler at stat.math.ethz.ch> wrote: > Subject: Re: [Rd] stopifnot > To: "Suharto Anggono Suharto Anggono" <suharto_anggono at yahoo.com> > Cc: r-devel at r-project.org > Date: Monday, 4 March, 2019, 4:59 PM>>>>> Suharto Anggono Suharto Anggono via R-devel>>>>>> ? ? on Sat, 2 Mar 2019 08:28:23 +0000 writes:>>>>> Suharto Anggono Suharto Anggono via R-devel>>>>>> ? ? on Sat, 2 Mar 2019 08:28:23 +0000 writes: > ? ? > A private reply by Martin made me realize that I was wrong about > ? ? > stopifnot(exprs=TRUE) . > ? ? > It actually works fine. I apologize. What I tried and was failed was > ? ? > stopifnot(exprs=T) . > ? ? > Error in exprs[[1]] : object of type 'symbol' is not subsettable > indeed! .. and your patch below does address that, too. > ? ? > The shortcut > ? ? > assert <- function(exprs) stopifnot(exprs = exprs) > ? ? > mentioned in "Warning" section of the documentation similarly fails when called, for example > ? ? > assert({}) > ? ? > About shortcut, a definition that rather works: > ? ? > assert <- function(exprs) eval.parent(substitute(stopifnot(exprs = exprs))) > Interesting... thank you for the suggestion!? I plan to add it > to the help page and then use it a bit .. before considering more. > ? ? > Looking at https://stat.ethz.ch/pipermail/r-devel/2017-May/074227.html , using sys.parent() may be not good. For example, in > ? ? > f <- function() stopifnot(exprs={FALSE}, local=FALSE); f() > I'm glad you found this too.. I did have "uneasy feelings" about > using sys.parent(2) to find the correct call ..? and I'm still > not 100% sure about the smart computation of 'n' for > sys.call(n-1) ... but I agree we should move in that direction > as it is so much faster than using withCallingHandlers() + tryCatch() > for all the expressions. > In my tests your revised patch (including the simplificationn > you sent 4 hours later) seems good and indeed does have very > good timing in simple experiments. > It will lead to some error messages being changed, > but in the examples I've seen,? the few changes were acceptable > (sometimes slightly less helpful, sometimes easier to read). > Martin > ? ? > A revised patch (also with simpler 'cl'): > ? ? > --- stop.R? ? 2019-02-27 16:15:45.324167577 +0000 > ? ? > +++ stop_new.R? ? 2019-03-02 06:21:35.919471080 +0000 > ? ? > @@ -1,7 +1,7 @@ > ? ? > #? File src/library/base/R/stop.R > ? ? > #? Part of the R package, https://www.R-project.org > ? ? > # > ? ? > -#? Copyright (C) 1995-2018 The R Core Team > ? ? > +#? Copyright (C) 1995-2019 The R Core Team > ? ? > # > ? ? > #? This program is free software; you can redistribute it and/or modify > ? ? > #? it under the terms of the GNU General Public License as published by > ? ? > @@ -33,25 +33,28 @@ > ? ? > stopifnot <- function(..., exprs, local = TRUE) > ? ? > { > ? ? > +? ? n <- ...length() > ? ? > missE <- missing(exprs) > ? ? > -? ? cl <- > ? ? > if(missE) {? ## use '...' instead of exprs > ? ? > -? ? ? ? match.call(expand.dots=FALSE)$... > ? ? > } else { > ? ? > -? ? ? ? if(...length()) > ? ? > +? ? ? ? if(n) > ? ? > stop("Must use 'exprs' or unnamed expressions, but not both") > ? ? > envir <- if (isTRUE(local)) parent.frame() > ? ? > else if(isFALSE(local)) .GlobalEnv > ? ? > else if (is.environment(local)) local > ? ? > else stop("'local' must be TRUE, FALSE or an environment") > ? ? > exprs <- substitute(exprs) # protect from evaluation > ? ? > -? ? ? ? E1 <- exprs[[1]] > ? ? > +? ? ? ? E1 <- if(is.call(exprs)) exprs[[1]] > ? ? > +? ? ? ? cl <- > ? ? > if(identical(quote(`{`), E1)) # { ... } > ? ? > -? ? ? ? do.call(expression, as.list(exprs[-1])) > ? ? > +? ? ? ? exprs > ? ? > else if(identical(quote(expression), E1)) > ? ? > -? ? ? ? eval(exprs, envir=envir) > ? ? > +? ? ? ? exprs > ? ? > else > ? ? > -? ? ? ? as.expression(exprs) # or fail .. > ? ? > +? ? ? ? call("expression", exprs) # or fail .. > ? ? > +? ? ? ? if(!is.null(names(cl))) names(cl) <- NULL > ? ? > +? ? ? ? cl[[1]] <- sys.call()[[1]] > ? ? > +? ? ? ? return(eval(cl, envir=envir)) > ? ? > } > ? ? > Dparse <- function(call, cutoff = 60L) { > ? ? > ch <- deparse(call, width.cutoff = cutoff) > ? ? > @@ -62,14 +65,10 @@ > ? ? > abbrev <- function(ae, n = 3L) > ? ? > paste(c(head(ae, n), if(length(ae) > n) "...."), collapse="\n? ") > ? ? > ## > ? ? > -? ? for (i in seq_along(cl)) { > ? ? > -? ? cl.i <- cl[[i]] > ? ? > -? ? ## r <- eval(cl.i, ..)? # with correct warn/err messages: > ? ? > -? ? r <- withCallingHandlers( > ? ? > -? ? ? ? tryCatch(if(missE) ...elt(i) else eval(cl.i, envir=envir), > ? ? > -? ? ? ? ? ? error = function(e) { e$call <- cl.i; stop(e) }), > ? ? > -? ? ? ? warning = function(w) { w$call <- cl.i; w }) > ? ? > +? ? for (i in seq_len(n)) { > ? ? > +? ? r <- ...elt(i) > ? ? > if (!(is.logical(r) && !anyNA(r) && all(r))) { > ? ? > +? ? ? ? cl.i <- match.call(expand.dots=FALSE)$...[[i]] > ? ? > msg <- ## special case for decently written 'all.equal(*)': > ? ? > if(is.call(cl.i) && identical(cl.i[[1]], quote(all.equal)) && > ? ? > (is.null(ni <- names(cl.i)) || length(cl.i) == 3L || > ? ? > @@ -84,7 +83,12 @@ > ? ? > "%s are not all TRUE"), > ? ? > Dparse(cl.i)) > ? ? > -? ? ? ? stop(simpleError(msg, call = sys.call(-1))) > ? ? > +? ? ? ? n <- sys.nframe() > ? ? > +? ? ? ? if((p <- n-3) > 0 && > ? ? > +? ? ? ? ? identical(sys.function(p), sys.function(n)) && > ? ? > +? ? ? ? ? eval(expression(!missE), p)) # originally stopifnot(exprs=*) > ? ? > +? ? ? ? n <- p > ? ? > +? ? ? ? stop(simpleError(msg, call = if(n > 1) sys.call(n-1))) > ? ? > } > ? ? > } > ? ? > invisible() > ? ? > -------------------------------------------- > ? ? > On Fri, 1/3/19, Martin Maechler <maechler at stat.math.ethz.ch> wrote: > ? ? > Subject: Re: [Rd] stopifnot > ? ? > Cc: "Martin Maechler" <maechler at stat.math.ethz.ch>, r-devel at r-project.org > ? ? > Date: Friday, 1 March, 2019, 6:40 PM>>>>> Suharto Anggono Suharto Anggono> ? ? >>>>>>? ?? on Wed, 27 Feb 2019 22:46:04 +0000 writes: > ? ? > [...] > ? ? >? ?? > Another thing: currently, > ? ? >? ?? > stopifnot(exprs=TRUE) > ? ? >? ?? > fails. > ? ? > good catch - indeed! > ? ? > I've started to carefully test and try the interesting nice > ? ? > patch you've provided below. > ? ? > [...] > ? ? > Martin > ? ? >? ?? > A patch: > ? ? >? ?? > --- stop.R? ? 2019-02-27 16:15:45.324167577 +0000 > ? ? >? ?? > +++ stop_new.R? ? 2019-02-27 16:22:15.936203541 +0000 > ? ? >? ?? > @@ -1,7 +1,7 @@ > ? ? >? ?? > #? File src/library/base/R/stop.R > ? ? >? ?? > #? Part of the R package, https://www.R-project.org > ? ? >? ?? > # > ? ? >? ?? > -#? Copyright (C) 1995-2018 The R Core Team > ? ? >? ?? > +#? Copyright (C) 1995-2019 The R Core Team > ? ? >? ?? > # > ? ? >? ?? > #? This program is free software; you can redistribute it and/or modify > ? ? >? ?? > #? it under the terms of the GNU General Public License as published by > ? ? >? ?? > @@ -33,25 +33,27 @@ > ? ? >? ?? > stopifnot <- function(..., exprs, local = TRUE) > ? ? >? ?? > { > ? ? >? ?? > +? ? n <- ...length() > ? ? >? ?? > missE <- missing(exprs) > ? ? >? ?? > -? ? cl <- > ? ? >? ?? > if(missE) {? ## use '...' instead of exprs > ? ? >? ?? > -? ? ? ? match.call(expand.dots=FALSE)$... > ? ? >? ?? > } else { > ? ? >? ?? > -? ? ? ? if(...length()) > ? ? >? ?? > +? ? ? ? if(n) > ? ? >? ?? > stop("Must use 'exprs' or unnamed expressions, but not both") > ? ? >? ?? > envir <- if (isTRUE(local)) parent.frame() > ? ? >? ?? > else if(isFALSE(local)) .GlobalEnv > ? ? >? ?? > else if (is.environment(local)) local > ? ? >? ?? > else stop("'local' must be TRUE, FALSE or an environment") > ? ? >? ?? > exprs <- substitute(exprs) # protect from evaluation > ? ? >? ?? > -? ? ? ? E1 <- exprs[[1]] > ? ? >? ?? > +? ? ? ? E1 <- if(is.call(exprs)) exprs[[1]] > ? ? >? ?? > +? ? ? ? cl <- > ? ? >? ?? > if(identical(quote(`{`), E1)) # { ... } > ? ? >? ?? > -? ? ? ? do.call(expression, as.list(exprs[-1])) > ? ? >? ?? > +? ? ? ? exprs[-1] > ? ? >? ?? > else if(identical(quote(expression), E1)) > ? ? >? ?? > eval(exprs, envir=envir) > ? ? >? ?? > else > ? ? >? ?? > as.expression(exprs) # or fail .. > ? ? >? ?? > +? ? ? ? if(!is.null(names(cl))) names(cl) <- NULL > ? ? >? ?? > +? ? ? ? return(eval(as.call(c(sys.call()[[1]], as.list(cl))), envir=envir)) > ? ? >? ?? > } > ? ? >? ?? > Dparse <- function(call, cutoff = 60L) { > ? ? >? ?? > ch <- deparse(call, width.cutoff = cutoff) > ? ? >? ?? > @@ -62,14 +64,10 @@ > ? ? >? ?? > abbrev <- function(ae, n = 3L) > ? ? >? ?? > paste(c(head(ae, n), if(length(ae) > n) "...."), collapse="\n? ") > ? ? >? ?? > ## > ? ? >? ?? > -? ? for (i in seq_along(cl)) { > ? ? >? ?? > -? ? cl.i <- cl[[i]] > ? ? >? ?? > -? ? ## r <- eval(cl.i, ..)? # with correct warn/err messages: > ? ? >? ?? > -? ? r <- withCallingHandlers( > ? ? >? ?? > -? ? ? ? tryCatch(if(missE) ...elt(i) else eval(cl.i, envir=envir), > ? ? >? ?? > -? ? ? ? ? ? error = function(e) { e$call <- cl.i; stop(e) }), > ? ? >? ?? > -? ? ? ? warning = function(w) { w$call <- cl.i; w }) > ? ? >? ?? > +? ? for (i in seq_len(n)) { > ? ? >? ?? > +? ? r <- ...elt(i) > ? ? >? ?? > if (!(is.logical(r) && !anyNA(r) && all(r))) { > ? ? >? ?? > +? ? ? ? cl.i <- match.call(expand.dots=FALSE)$...[[i]] > ? ? >? ?? > msg <- ## special case for decently written 'all.equal(*)': > ? ? >? ?? > if(is.call(cl.i) && identical(cl.i[[1]], quote(all.equal)) && > ? ? >? ?? > (is.null(ni <- names(cl.i)) || length(cl.i) == 3L || > ? ? >? ?? > @@ -84,7 +82,11 @@ > ? ? >? ?? > "%s are not all TRUE"), > ? ? >? ?? > Dparse(cl.i)) > ? ? >? ?? > -? ? ? ? stop(simpleError(msg, call = sys.call(-1))) > ? ? >? ?? > +? ? ? ? p <- sys.parent() > ? ? >? ?? > +? ? ? ? if(p && identical(sys.function(p), stopifnot) && > ? ? >? ?? > +? ? ? ? ? !eval(expression(missE), p)) # originally stopifnot(exprs=*) > ? ? >? ?? > +? ? ? ? p <- sys.parent(2) > ? ? >? ?? > +? ? ? ? stop(simpleError(msg, call = if(p) sys.call(p))) > ? ? >? ?? > } > ? ? >? ?? > } > ? ? >? ?? > invisible() > ? ? > ______________________________________________ > ? ? > R-devel at r-project.org mailing list > ? ? > https://stat.ethz.ch/mailman/listinfo/r-devel
>>>>> Martin Maechler >>>>> on Tue, 5 Mar 2019 21:04:08 +0100 writes:>>>>> Suharto Anggono Suharto Anggono >>>>> on Tue, 5 Mar 2019 17:29:20 +0000 writes:>> Another possible shortcut definition: >> assert <- function(exprs) >> do.call("stopifnot", list(exprs = substitute(exprs), local = parent.frame())) > Thank you. I think this is mostly a matter of taste, but I > liked your version using eval() & substitute() a bit more. For > me, do.call() is a heavy hammer I only like to use when needed.. > Or would there be advantages of this version? > Indeed (as you note below) one important consideration is the exact > message that is produced when one assertion fails. >> After thinking again, I propose to use >> ??? ? ? stop(simpleError(msg, call = if(p <- sys.parent()) sys.call(p))) > That would of course be considerably simpler indeed, part "2 a" of these: >> - It seems that the call is the call of the frame where stopifnot(...) is evaluated. Because that is the correct context, I think it is good. >> - It is simpler and also works for call that originally comes from stopifnot(exprs=*) . >> - It allows shortcut ('assert') to have the same call in error message as stopifnot(exprs=*) . > That may be another good reason in addition to code simplicity. > I will have to see if this extra simplification does not loose > more than I'd want. >> Another thing: Is it intended that >> do.call("stopifnot", list(exprs = expression())) >> evaluates each element of the expression object? > ?? I really don't know. Even though such a case looks > "unusual" (to say the least), in principle I'd like that > expressions are evaluated sequentially until the first non-TRUE > result. With a concrete example, I do like what we have > currently in unchanged R-devel, but also in R 3.5.x, i.e., in > the following, not any "NOT GOOD" should pop up: >> stopifnot(exprs = expression(1==1, 2 < 1, stop("NOT GOOD!\n"))) > Error: 2 < 1 is not TRUE >> do.call(stopifnot, list(exprs = expression(1==1, 2 < 1, stop("NOT GOOD!\n")))) > Error in do.call(stopifnot, list(exprs = expression(1 == 1, 2 < 1, cat("NOT GOOD!\n")))) : > 2 < 1 is not TRUE >> > Hmm, it seems I do not understand what you ask above in your > "Another thing: .." >> If so, maybe add a case for 'cl', like >> ??? ? ? else if(is.expression(exprs)) >> ??? ??? as.call(c(quote(expression), exprs)) > that seems simple indeed, but at the moment, I cannot see one example > where it makes a difference ... or then I'm "blind" .. ??? > Best, > Martin Some more testing of examples lead me to keep the more sophisticated "computation" of 'n' for the sys.call(n-1). Main reason: If one of the expression is not all TRUE, I really don't want to see the full 'stopifnot(....)' call in the printed error message. I do want to encourage that stopifnot() asserts many things and so its own call should really not be shown. Also I really wanted to commit something, notably also fixing the stopifnot(exprs = T) bug, so R-devel (rev >= 76203 ) now contains a simpler and much faster stopifnot() than previously [and than the R 3.5.x series]. I agree that the final decisions on getting a call (or not -- which was a very good idea by you!) and which parent's call should be used may deserve some future tinkering.. Thank you again, Suharto Anggono, for your contributions to making R better ! Martin