stopifnot

classic Classic list List threaded Threaded
11 messages Options
Reply | Threaded
Open this post in threaded view
|

stopifnot

R devel mailing list
From https://github.com/HenrikBengtsson/Wishlist-for-R/issues/70 :
... and follow up note from 2018-03-15: Ouch... in R-devel, stopifnot() has become yet 4-5 times slower;

...
which is due to a complete rewrite using tryCatch() and withCallingHandlers().


From https://stat.ethz.ch/pipermail/r-devel/2017-May/074256.html , it seems that 'tryCatch' was used to avoid the following example from giving error message with 'eval' call and 'withCallingHandlers' was meant to handle similar case for warning.
tst <- function(y) { stopifnot(is.numeric(y)); y+ 1 }
try(tst())

However,
withCallingHandlers(<something>,
warning = function(w) { w$call <- cl.i; w })
actally has no effect. In current code of function 'stopifnot', 'eval' is used only in handling stopifnot(exprs=) . The warning message from
stopifnot(exprs={warning()})
has 'eval' call:
In eval(cl.i, envir = envir) :

This may work.
withCallingHandlers(<something>,
warning = function(w) {
w$call <- cl.i; warning(w); invokeRestart("muffleWarning") })


Current documentation says:
Since R version 3.5.0, expressions are evaluated sequentially, and hence evaluation stops as soon as there is a "non-TRUE", asnindicated by the above conceptual equivalence statement. Further, when such an expression signals an error or warning, its conditionCall() no longer contains the full stopifnot call, but just the erroneous expression.

I assume that "no longer contains ..." is supposed to be the effect of the use of 'withCallingHandlers' and 'tryCatch' in 'stopifnot'.

Actually, "contains the full stopifnot call" is not always the case in R before version 3.5.0. Normally, the call is the "innermost context".

Example:
stopifnot((1:2) + (1:3) > 0)
Warning message:
In (1:2) + (1:3) :
  longer object length is not a multiple of shorter object length

Example that gives error:
stopifnot(is.na(log("a")))
R 3.5.0:
R 3.3.2:

______________________________________________
[hidden email] mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
Reply | Threaded
Open this post in threaded view
|

Re: stopifnot

Martin Maechler
>>>>> Suharto Anggono Suharto Anggono via R-devel
>>>>>     on Sun, 24 Feb 2019 14:22:48 +0000 writes:

    >> From https://github.com/HenrikBengtsson/Wishlist-for-R/issues/70 :
    > ... and follow up note from 2018-03-15: Ouch... in R-devel, stopifnot() has become yet 4-5 times slower;

    > ...
    > which is due to a complete rewrite using tryCatch() and withCallingHandlers().


    >> From https://stat.ethz.ch/pipermail/r-devel/2017-May/074256.html , it seems that 'tryCatch' was used to avoid the following example from giving error message with 'eval' call and 'withCallingHandlers' was meant to handle similar case for warning.
    > tst <- function(y) { stopifnot(is.numeric(y)); y+ 1 }
    > try(tst())

    > However,
    > withCallingHandlers(<something>,
    > warning = function(w) { w$call <- cl.i; w })
    > actally has no effect. In current code of function 'stopifnot', 'eval' is used only in handling stopifnot(exprs=) . The warning message from
    > stopifnot(exprs={warning()})
    > has 'eval' call:
    > In eval(cl.i, envir = envir) :

    > This may work.
    > withCallingHandlers(<something>,
    > warning = function(w) {
    > w$call <- cl.i; warning(w); invokeRestart("muffleWarning") })


    > Current documentation says:
    > Since R version 3.5.0, expressions are evaluated sequentially, and hence evaluation stops as soon as there is a "non-TRUE", asnindicated by the above conceptual equivalence statement. Further, when such an expression signals an error or warning, its conditionCall() no longer contains the full stopifnot call, but just the erroneous expression.

    > I assume that "no longer contains ..." is supposed to be the effect of the use of 'withCallingHandlers' and 'tryCatch' in 'stopifnot'.

    > Actually, "contains the full stopifnot call" is not always the case in R before version 3.5.0. Normally, the call is the "innermost context".

Thank you Suharto, for thinking about these issues and being
constructive, trying to improve the current state.

Unfortunately, I do not quite understand what you are trying to
say here.

The main somewhat recent changes to stopifnot() have been (in
inverse time ordering)

1) Do what the documentation always promised, namely eval() the
   expressions one by one, and stop evaluation as soon as one of
   them is not all(.) TRUE.
   For that reason, the previously used idiom   'list(...)'
   is a no go, as "of course", it evaluates all the expressions in '...'

2) Try to ensure that warning() and stop()/error messages are
   shown the same {as closely as feasible}  to how they are
   shown outside of stopifnot(.)
     ==> partly the topic of this e-mail.

3) [2.5 years ago:] stopifnot() became smart about all.equal(.) expressions,
  showing the all.equal() string if it was not TRUE:
  In older R versions (<= 3.3.x ?), we had

      > stopifnot(all.equal(pi, 3.1415))
     Error: all.equal(pi, 3.1415) is not TRUE

  where as in R (>= 3.4.0 at least):

      > stopifnot(all.equal(pi, 3.1415))
      Error: pi and 3.1415 are not equal:
        Mean relative difference: 2.949255e-05


One example of what I meant with the above documentation ("no
longer contains")  is the following:

In R 3.5.x,

   > lf <- list(fm = y ~ f(x), osf = ~ sin(x))
   > stopifnot(identical(deparse(lf), deparse(lf, control="all")))
   Warning message:
   In deparse(lf, control = "all") : deparse may be incomplete
   >

If I change the calling handler to use the
invokeRestart("muffleWarning") which I understand you are
proposing, then the message becomes

   Warning message:
   In identical(deparse(lf, control = "all"), deparse(lf)) :
     deparse may be incomplete

which is less useful as I can no longer see directly which of
the deparse() produced the warning.

    > Example:
    > stopifnot((1:2) + (1:3) > 0)
    > Warning message:
    > In (1:2) + (1:3) :
    >   longer object length is not a multiple of shorter object length

Which is the good answer
(whereas also showing "> 0" in the warning is slightly off).

Again, if I'd use the  ..muffleWarning.. code instead, the above
would change to the worse

     Warning message:
     In (1:2) + (1:3) > 0 :
       longer object length is not a multiple of shorter object length

which "wrongly includes the '> 0'.
So I guess I really don't understand what you are proposing, or
would like to change  ...


    > Example that gives error:
    > stopifnot(is.na(log("a")))
    > R 3.5.0:
    > R 3.3.2:

That's a good one: we want the error message *not to* mention
is.na(.) but just 'log': i.e.,

We'd like  [ R versions <= 3.4.4 ] :

> stopifnot(is.na(log("a")))
Error in log("a") : non-numeric argument to mathematical function

as opposed to [ R version >= 3.5.0 ] :

> stopifnot(is.na(log("a")))
Error in is.na(log("a")) : non-numeric argument to mathematical function

-----------------------------------------

Again, I'm sure I partly failed to understand what you said in
your e-mail and apologize for that.

Of course, I'm happy and glad to discuss improvements to
stopifnot() which improve speed (while retaining important
current functionality)  or also just improve current
functionality
-- e.g. get the "better" error message in the stopifnot(is.na(log("a")))
   example.

High regards,
Martin Maechler

______________________________________________
[hidden email] mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
Reply | Threaded
Open this post in threaded view
|

Re: stopifnot

R devel mailing list
In reply to this post by R devel mailing list
My points:
- The 'withCallingHandlers' construct that is used in current 'stopifnot' code has no effect. Without it, the warning message is the same. The overridden warning is not raised. The original warning stays.
- Overriding call in error and warning to 'cl.i' doesn't always give better outcome. The original call may be "narrower" than 'cl.i'.

I have found these examples.
identity(is.na(log()))
identity(is.na(log("a")))

Error message from the first contains full call. Error message from the second doesn't.

So, how about being "natural", not using 'withCallingHandlers' and 'tryCatch' in 'stopifnot'?

Another thing: currently,
stopifnot(exprs=TRUE)
fails.

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()

--------------------------------------------
On Wed, 27/2/19, Martin Maechler <[hidden email]> wrote:

 Subject: Re: [Rd] stopifnot

 Cc: [hidden email]
 Date: Wednesday, 27 February, 2019, 5:36 PM

>>>>> Suharto Anggono Suharto Anggono via R-devel
>>>>>    on Sun, 24 Feb 2019 14:22:48 +0000 writes:

    >> From https://github.com/HenrikBengtsson/Wishlist-for-R/issues/70 :
    > ... and follow up note from 2018-03-15: Ouch... in R-devel, stopifnot() has become yet 4-5 times slower;

    > ...
    > which is due to a complete rewrite using tryCatch() and withCallingHandlers().


    >> From https://stat.ethz.ch/pipermail/r-devel/2017-May/074256.html , it seems that 'tryCatch' was used to avoid the following example from giving error message with 'eval' call and 'withCallingHandlers' was meant to handle similar case for warning.
    > tst <- function(y) { stopifnot(is.numeric(y)); y+ 1 }
    > try(tst())

    > However,
    > withCallingHandlers(<something>,
    > warning = function(w) { w$call <- cl.i; w })
    > actally has no effect. In current code of function 'stopifnot', 'eval' is used only in handling stopifnot(exprs=) . The warning message from
    > stopifnot(exprs={warning()})
    > has 'eval' call:
    > In eval(cl.i, envir = envir) :

    > This may work.
    > withCallingHandlers(<something>,
    > warning = function(w) {
    > w$call <- cl.i; warning(w); invokeRestart("muffleWarning") })


    > Current documentation says:
    > Since R version 3.5.0, expressions are evaluated sequentially, and hence evaluation stops as soon as there is a "non-TRUE", asnindicated by the above conceptual equivalence statement. Further, when such an expression signals an error or warning, its conditionCall() no longer contains the full stopifnot call, but just the erroneous expression.

    > I assume that "no longer contains ..." is supposed to be the effect of the use of 'withCallingHandlers' and 'tryCatch' in 'stopifnot'.

    > Actually, "contains the full stopifnot call" is not always the case in R before version 3.5.0. Normally, the call is the "innermost context".

Thank you Suharto, for thinking about these issues and being
constructive, trying to improve the current state.

Unfortunately, I do not quite understand what you are trying to
say here.

The main somewhat recent changes to stopifnot() have been (in
inverse time ordering)

1) Do what the documentation always promised, namely eval() the
  expressions one by one, and stop evaluation as soon as one of
  them is not all(.) TRUE.
  For that reason, the previously used idiom  'list(...)'
  is a no go, as "of course", it evaluates all the expressions in '...'

2) Try to ensure that warning() and stop()/error messages are
  shown the same {as closely as feasible}  to how they are
  shown outside of stopifnot(.)
            ==> partly the topic of this e-mail.

3) [2.5 years ago:] stopifnot() became smart about all.equal(.) expressions,
  showing the all.equal() string if it was not TRUE:
  In older R versions (<= 3.3.x ?), we had

      > stopifnot(all.equal(pi, 3.1415))
    Error: all.equal(pi, 3.1415) is not TRUE

  where as in R (>= 3.4.0 at least):

      > stopifnot(all.equal(pi, 3.1415))
      Error: pi and 3.1415 are not equal:
    Mean relative difference: 2.949255e-05


One example of what I meant with the above documentation ("no
longer contains")  is the following:

In R 3.5.x,

  > lf <- list(fm = y ~ f(x), osf = ~ sin(x))
  > stopifnot(identical(deparse(lf), deparse(lf, control="all")))
  Warning message:
  In deparse(lf, control = "all") : deparse may be incomplete
  >

If I change the calling handler to use the
invokeRestart("muffleWarning") which I understand you are
proposing, then the message becomes

  Warning message:
  In identical(deparse(lf, control = "all"), deparse(lf)) :
    deparse may be incomplete

which is less useful as I can no longer see directly which of
the deparse() produced the warning.

    > Example:
    > stopifnot((1:2) + (1:3) > 0)
    > Warning message:
    > In (1:2) + (1:3) :
    >   longer object length is not a multiple of shorter object length

Which is the good answer
(whereas also showing "> 0" in the warning is slightly off).

Again, if I'd use the  ..muffleWarning.. code instead, the above
would change to the worse

    Warning message:
    In (1:2) + (1:3) > 0 :
      longer object length is not a multiple of shorter object length

which "wrongly includes the '> 0'.
So I guess I really don't understand what you are proposing, or
would like to change  ...


    > Example that gives error:
    > stopifnot(is.na(log("a")))
    > R 3.5.0:
    > R 3.3.2:

That's a good one: we want the error message *not to* mention
is.na(.) but just 'log': i.e.,

We'd like  [ R versions <= 3.4.4 ] :

> stopifnot(is.na(log("a")))
Error in log("a") : non-numeric argument to mathematical function

as opposed to [ R version >= 3.5.0 ] :

> stopifnot(is.na(log("a")))
Error in is.na(log("a")) : non-numeric argument to mathematical function

-----------------------------------------

Again, I'm sure I partly failed to understand what you said in
your e-mail and apologize for that.

Of course, I'm happy and glad to discuss improvements to
stopifnot() which improve speed (while retaining important
current functionality)  or also just improve current
functionality
-- e.g. get the "better" error message in the stopifnot(is.na(log("a")))

  example.


High regards,
Martin Maechler

______________________________________________
[hidden email] mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
Reply | Threaded
Open this post in threaded view
|

Re: stopifnot

Martin Maechler
>>>>> Suharto Anggono Suharto Anggono
>>>>>     on Wed, 27 Feb 2019 22:46:04 +0000 writes:

    > My points:
    > - The 'withCallingHandlers' construct that is used in current 'stopifnot' code has no effect. Without it, the warning message is the same. The overridden warning is not raised. The original warning stays.

    > - Overriding call in error and warning to 'cl.i' doesn't always give better outcome. The original call may be "narrower" than 'cl.i'.

I see.  Thank you for stating the summary.

    > I have found these examples.
    > identity(is.na(log()))
    > identity(is.na(log("a")))

    > Error message from the first contains full call. Error message from the second doesn't.

    > So, how about being "natural", not using 'withCallingHandlers' and 'tryCatch' in 'stopifnot'?

If we can achieve good (or better) messages as before, I
entirely agree.

Originally, one "design principle" for stopifnot() had been to
create a relatively simple "self explaining" (for code readers)
function with that functionality.

The all.equal() special treatment has really added an extra
level of usefulness, and the somewhat recent ensuring of careful
sequential eval() is also important.

Somewhere there I found I'd need the sophisticated error
catching [tryCatch() ..], but if turns that it is unneeded, I
think we'd all be more than happy.


    > 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.

Thank you very much for your careful and constructive
suggestions!  I'll get back after some testing {and fulfilling
quite a few other jobs/duties I've got these days ...}

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()

    > --------------------------------------------
    > On Wed, 27/2/19, Martin Maechler <[hidden email]> wrote:

    > Subject: Re: [Rd] stopifnot
    > To: "Suharto Anggono Suharto Anggono" <[hidden email]>
    > Cc: [hidden email]
    > Date: Wednesday, 27 February, 2019, 5:36 PM
 
>>>>> Suharto Anggono Suharto Anggono via R-devel
    >>>>>>     on Sun, 24 Feb 2019 14:22:48 +0000 writes:

    >     >> From https://github.com/HenrikBengtsson/Wishlist-for-R/issues/70 :
    >     > ... and follow up note from 2018-03-15: Ouch... in R-devel, stopifnot() has become yet 4-5 times slower;

    >     > ...
    >     > which is due to a complete rewrite using tryCatch() and withCallingHandlers().


    >     >> From https://stat.ethz.ch/pipermail/r-devel/2017-May/074256.html , it seems that 'tryCatch' was used to avoid the following example from giving error message with 'eval' call and 'withCallingHandlers' was meant to handle similar case for warning.
    >     > tst <- function(y) { stopifnot(is.numeric(y)); y+ 1 }
    >     > try(tst())

    >     > However,
    >     > withCallingHandlers(<something>,
    >     > warning = function(w) { w$call <- cl.i; w })
    >     > actally has no effect. In current code of function 'stopifnot', 'eval' is used only in handling stopifnot(exprs=) . The warning message from
    >     > stopifnot(exprs={warning()})
    >     > has 'eval' call:
    >     > In eval(cl.i, envir = envir) :

    >     > This may work.
    >     > withCallingHandlers(<something>,
    >     > warning = function(w) {
    >     > w$call <- cl.i; warning(w); invokeRestart("muffleWarning") })


    >     > Current documentation says:
    >     > Since R version 3.5.0, expressions are evaluated sequentially, and hence evaluation stops as soon as there is a "non-TRUE", asnindicated by the above conceptual equivalence statement. Further, when such an expression signals an error or warning, its conditionCall() no longer contains the full stopifnot call, but just the erroneous expression.

    >     > I assume that "no longer contains ..." is supposed to be the effect of the use of 'withCallingHandlers' and 'tryCatch' in 'stopifnot'.

    >     > Actually, "contains the full stopifnot call" is not always the case in R before version 3.5.0. Normally, the call is the "innermost context".

    > Thank you Suharto, for thinking about these issues and being
    > constructive, trying to improve the current state.

    > Unfortunately, I do not quite understand what you are trying to
    > say here.

    > The main somewhat recent changes to stopifnot() have been (in
    > inverse time ordering)

    > 1) Do what the documentation always promised, namely eval() the
    >   expressions one by one, and stop evaluation as soon as one of
    >   them is not all(.) TRUE.
    >   For that reason, the previously used idiom  'list(...)'
    >   is a no go, as "of course", it evaluates all the expressions in '...'

    > 2) Try to ensure that warning() and stop()/error messages are
    >   shown the same {as closely as feasible}  to how they are
    >   shown outside of stopifnot(.)
    >             ==> partly the topic of this e-mail.

    > 3) [2.5 years ago:] stopifnot() became smart about all.equal(.) expressions,
    >   showing the all.equal() string if it was not TRUE:
    >   In older R versions (<= 3.3.x ?), we had

    >       > stopifnot(all.equal(pi, 3.1415))
    >     Error: all.equal(pi, 3.1415) is not TRUE

    >   where as in R (>= 3.4.0 at least):

    >       > stopifnot(all.equal(pi, 3.1415))
    >       Error: pi and 3.1415 are not equal:
    >     Mean relative difference: 2.949255e-05


    > One example of what I meant with the above documentation ("no
    > longer contains")  is the following:

    > In R 3.5.x,

    >   > lf <- list(fm = y ~ f(x), osf = ~ sin(x))
    >   > stopifnot(identical(deparse(lf), deparse(lf, control="all")))
    >   Warning message:
    >   In deparse(lf, control = "all") : deparse may be incomplete
    >   >

    > If I change the calling handler to use the
    > invokeRestart("muffleWarning") which I understand you are
    > proposing, then the message becomes

    >   Warning message:
    >   In identical(deparse(lf, control = "all"), deparse(lf)) :
    >     deparse may be incomplete

    > which is less useful as I can no longer see directly which of
    > the deparse() produced the warning.

    >     > Example:
    >     > stopifnot((1:2) + (1:3) > 0)
    >     > Warning message:
    >     > In (1:2) + (1:3) :
    >     >   longer object length is not a multiple of shorter object length

    > Which is the good answer
    > (whereas also showing "> 0" in the warning is slightly off).

    > Again, if I'd use the  ..muffleWarning.. code instead, the above
    > would change to the worse

    >     Warning message:
    >     In (1:2) + (1:3) > 0 :
    >       longer object length is not a multiple of shorter object length

    > which "wrongly includes the '> 0'.
    > So I guess I really don't understand what you are proposing, or
    > would like to change  ...


    >     > Example that gives error:
    >     > stopifnot(is.na(log("a")))
    >     > R 3.5.0:
    >     > R 3.3.2:

    > That's a good one: we want the error message *not to* mention
    > is.na(.) but just 'log': i.e.,

    > We'd like  [ R versions <= 3.4.4 ] :

    >> stopifnot(is.na(log("a")))
    > Error in log("a") : non-numeric argument to mathematical function

    > as opposed to [ R version >= 3.5.0 ] :

    >> stopifnot(is.na(log("a")))
    > Error in is.na(log("a")) : non-numeric argument to mathematical function

    > -----------------------------------------

    > Again, I'm sure I partly failed to understand what you said in
    > your e-mail and apologize for that.

    > Of course, I'm happy and glad to discuss improvements to
    > stopifnot() which improve speed (while retaining important
    > current functionality)  or also just improve current
    > functionality
    > -- e.g. get the "better" error message in the stopifnot(is.na(log("a")))

    >   example.


    > High regards,
    > Martin Maechler

______________________________________________
[hidden email] mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
Reply | Threaded
Open this post in threaded view
|

Re: stopifnot

R devel mailing list
In reply to this post by R devel mailing list
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

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)))

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()

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 <[hidden email]> wrote:

 Subject: Re: [Rd] stopifnot

 Cc: "Martin Maechler" <[hidden email]>, [hidden email]
 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()

______________________________________________
[hidden email] mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
Reply | Threaded
Open this post in threaded view
|

Re: stopifnot

R devel mailing list
In reply to this post by R devel mailing list
Instead of
if(!is.null(names(cl))) names(cl) <- NULL ,
just
names(cl) <- NULL
looks simpler and the memory usage and speed is not bad in my little experiment.

--------------------------------------------


 Subject: Re: [Rd] stopifnot
 To: [hidden email]
 Date: Saturday, 2 March, 2019, 3:28 PM
 
[...]

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()

______________________________________________
[hidden email] mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
Reply | Threaded
Open this post in threaded view
|

Re: stopifnot

Martin Maechler
In reply to this post by R devel mailing list
>>>>> 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 <[hidden email]> wrote:

    > Subject: Re: [Rd] stopifnot

    > Cc: "Martin Maechler" <[hidden email]>, [hidden email]
    > 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()

    > ______________________________________________
    > [hidden email] mailing list
    > https://stat.ethz.ch/mailman/listinfo/r-devel

______________________________________________
[hidden email] mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
Reply | Threaded
Open this post in threaded view
|

Re: stopifnot

R devel mailing list
In reply to this post by R devel mailing list
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 <[hidden email]> wrote:

 Subject: Re: [Rd] stopifnot

 Cc: [hidden email]
 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 <[hidden email]> wrote:

    > Subject: Re: [Rd] stopifnot

    > Cc: "Martin Maechler" <[hidden email]>, [hidden email]
    > 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()


    > ______________________________________________
    > [hidden email] mailing list
    > https://stat.ethz.ch/mailman/listinfo/r-devel

______________________________________________
[hidden email] mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
Reply | Threaded
Open this post in threaded view
|

Re: stopifnot

Martin Maechler
>>>>> 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 <[hidden email]> wrote:

    > Subject: Re: [Rd] stopifnot
    > To: "Suharto Anggono Suharto Anggono" <[hidden email]>
    > Cc: [hidden email]
    > 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 <[hidden email]> wrote:

    >     > Subject: Re: [Rd] stopifnot

    >     > Cc: "Martin Maechler" <[hidden email]>, [hidden email]
    >     > 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()


    >     > ______________________________________________
    >     > [hidden email] mailing list
    >     > https://stat.ethz.ch/mailman/listinfo/r-devel

______________________________________________
[hidden email] mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
Reply | Threaded
Open this post in threaded view
|

Re: stopifnot

Martin Maechler
>>>>> 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

______________________________________________
[hidden email] mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
Reply | Threaded
Open this post in threaded view
|

Re: stopifnot

R devel mailing list
In reply to this post by R devel mailing list
By not using 'withCallingHandler' or 'tryCatch', the state is like 'stopifnot' in R 3.4.x. If 'stopifnot' becomes faster than in R 3.4.x when the expressions given to 'stopifnot' are all TRUE, it is because 'match.call' is not called. Credit is to https://github.com/HenrikBengtsson/Wishlist-for-R/issues/70 for the idea.

Speaking about 'match.call',
match.call()[[i+1L]]
can replace
match.call(expand.dots=FALSE)$...[[i]] .
Result of match.call() follows argument order in function definition. In 'stopifnot', '...' comes first.


Note that what I proposed lately was not merely
sys.call(sys.parent()) ,
but
if(p <- sys.parent()) sys.call(p) .
When sys.parent() is 0, which is the frame number of .GlobalEnv, the result is NULL. The result is never the current call. I believe that it is the call of sys.frame(sys.parent()) or parent.frame(), which is the frame where stopifnot(...) is evaluated, like I said before.
sys.frame(0) is .GlobalEnv, but sys.call(0) is current call, the same as sys.call() or sys.call(sys.nframe()). See https://stat.ethz.ch/pipermail/r-devel/2016-March/072511.html .

As far as I can see, full stopifnot(...) call can only appear from an error that happens during evaluation of an argument of 'stopifnot'. Because the error is not raised by 'stopifnot', the call in the error has nothing to do with how 'n' is computed in sys.call(n-1) , or even with use of sys.call(n-1) itself.

if(n > 1) sys.call(n-1)
that I proposed previously was aimed to be like
sys.call(-1)
in 'stopifnot' in R 3.5.x. Negative number counts back from current frame. The value of 'n' is sys.nframe() or (sys.nframe()-3). In my patch, stopifnot(exprs=*) drives stopifnot(...) call via 'eval'. I found that frames were generated for
stopifnot (exprs) -> eval -> eval (.Internal) -> stopifnot (...)
From stopifnot (...) , reaching stopifnot (exprs) takes 3 steps back.


Showing full call in error is not unique to 'stopifnot'. In my E-mail in https://stat.ethz.ch/pipermail/r-devel/2019-February/077386.html , I gave
identity(is.na(log()))
as an example. It gives
Error in identity(is.na(log())) :
  argument "x" is missing, with no default

Expanding further,
identity(identity(is.na(log())))
has the same error message, with only one call to 'identity'.

I guess that it is because 'log' and 'is.na' are primitive functions, but 'identity' is not. I guess that a primitive function doesn't have its own context, doesn't generate frame, so the innermost non-primitive function is taken as context.

However,
identity(is.na(log("a")))
gives
Error in log("a") : non-numeric argument to mathematical function

I guess that some primitive functions in some cases modify call to be shown in error or warning message.

options(error = expression(NULL))
library(compiler)
enableJIT(0)
f <- function(x) for (i in 1) x
f(is.numeric(y))
# Error: object 'y' not found
fc <- cmpfun(f)
fc(is.numeric(y))
# Error in fc(is.numeric(y)) : object 'y' not found

The above illustrates what happens in current 'stopifnot' without 'withCallingHandlers' or 'tryCatch'. For error during 'for', non-compiled and compiled versions are different. It surprised me.

'stopifnot' without 'withCallingHandlers' and 'tryCatch' is like in R 3.4.x. I had expected error from
stopifnot(is.numeric(y))
when 'y' doesn't exist to contain full 'stopifnot' call, as in R 3.4.x. My idea of calling 'stopifnot' again for stopifnot(exprs=*) was to avoid seeing 'eval' in error message of
stopifnot(exprs = { is.numeric(y) })
when 'y' doesn't exist, assuming that seeing
stopifnot(is.numeric(y))
in error message was OK. As an aside, calling 'eval' is faster than calling 'eval' multiple times.

If it is really wanted that error from
stopifnot(is.numeric(y))
when 'y' doesn't exist doesn't give full stopifnot(...) call, I think use of 'tryCatch' is unavoidable.


A minor advantage of 'assert' with 'do.call' is smaller traceback() .


With my revised patch, the 'else' clause for 'cl' gives
call("expression", exprs) .
For
do.call(stopifnot, list(exprs = expression())) ,
the whole expression object is taken as one.

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, stop("NOT GOOD!\n")))) :
  expression(1 == 1, 2 < 1, stop("NOT GOOD!\n")) are not all TRUE

To be the same as in R 3.5.x, the 'else' can be
as.call(c(quote(expression), as.expression(exprs)))

--------------------------------------------
On Wed, 6/3/19, Martin Maechler <[hidden email]> wrote:

 Subject: Re: [Rd] stopifnot

@r-project.org
 Cc: "Martin Maechler" <[hidden email]>
 Date: Wednesday, 6 March, 2019, 3:50 PM

>>>>> 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,
[[elided Yahoo spam]]


Martin

______________________________________________
[hidden email] mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel