[Rd] stopifnot
Martin Maechler
m@ech|er @end|ng |rom @t@t@m@th@ethz@ch
Tue Mar 5 21:04:08 CET 2019
>>>>> 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 using stat.math.ethz.ch> wrote:
> Subject: Re: [Rd] stopifnot
> To: "Suharto Anggono Suharto Anggono" <suharto_anggono using yahoo.com>
> Cc: r-devel using 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 using stat.math.ethz.ch> wrote:
> > Subject: Re: [Rd] stopifnot
> > Cc: "Martin Maechler" <maechler using stat.math.ethz.ch>, r-devel using 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 using r-project.org mailing list
> > https://stat.ethz.ch/mailman/listinfo/r-devel
More information about the R-devel
mailing list