[Rd] stopifnot() does not stop at first non-TRUE argument
Serguei Sokol
sokol at insa-toulouse.fr
Mon May 15 16:32:20 CEST 2017
Le 15/05/2017 à 15:37, Martin Maechler a écrit :
>>>>>> Serguei Sokol <sokol at insa-toulouse.fr>
>>>>>> on Mon, 15 May 2017 13:14:34 +0200 writes:
> > I see in the archives that the attachment cannot pass.
> > So, here is the code:
>
> [....... MM: I needed to reformat etc to match closely to
> the current source code which is in
> https://svn.r-project.org/R/trunk/src/library/base/R/stop.R
> or its corresponding github mirror
> https://github.com/wch/r-source/blob/trunk/src/library/base/R/stop.R
> ]
>
> > Best,
> > Serguei.
>
> Yes, something like that seems even simpler than Peter's
> suggestion...
>
> It currently breaks 'make check' in the R sources,
> specifically in tests/reg-tests-2.R (lines 6574 ff),
> the new code now gives
>
> > ## error messages from (C-level) evalList
> > tst <- function(y) { stopifnot(is.numeric(y)); y+ 1 }
> > try(tst())
> Error in eval(cl.i, pfr) : argument "y" is missing, with no default
>
> whereas previously it gave
>
> Error in stopifnot(is.numeric(y)) :
> argument "y" is missing, with no default
>
>
> But I think that change (of call stack in such an error case) is
> unavoidable and not a big problem.
It can be avoided but at price of customizing error() and warning() calls with something like:
wrn <- function(w) {w$call <- cl.i; warning(w)}
err <- function(e) {e$call <- cl.i; stop(e)}
...
tryCatch(r <- eval(cl.i, pfr), warning=wrn, error=err)
Serguei.
>
> --
>
> I'm still curious about Hervé's idea on using switch() for the
> issue.
>
> Martin
>
>
> > Le 15/05/2017 à 12:48, Serguei Sokol a écrit :
> >> Hello,
> >>
> >> I am a new on this list, so I introduce myself very briefly:
> >> my background is applied mathematics, more precisely scientific calculus
> >> applied for modeling metabolic systems, I am author/maintainer of
> >> few packages (Deriv, rmumps, arrApply).
> >>
> >> Now, on the subject of this discussion, I must say that I don't really understand
> >> Peter's argument:
> >>
> >> >>> To do it differently, you would have to do something like
> >> >>>
> >> >>> dots <- match.call(expand.dots=FALSE)$...
> >> >>>
> >> >>> and then explicitly evaluate each argument in turn in the caller
> >> >>> frame. This amount of nonstandard evaluation sounds like it would
> >> >>> incur a performance penalty, which could be undesirable.
> >> The first line of the current stopifnot()
> >> n <- length(ll <- list(...))
> >> already evaluates _all_ of the arguments
> >> in the caller frame. So to do the same only
> >> on a part of them (till the first FALSE or NA occurs)
> >> cannot be more penalizing than the current version, right?
> >>
> >> I attach here a slightly modified version called stopifnot_new()
> >> which works in accordance with the man page and
> >> where there are only two additional calls: parent.frame() and eval().
> >> I don't think it can be considered as real performance penalty
> >> as the same or bigger amount of (implicit) evaluations was
> >> already done in the current version:
> >>
> >>> source("stopifnot_new.R")
> >>> stopifnot_new(3 == 5, as.integer(2^32), a <- 12)
> >> Error: 3 == 5 is not TRUE
> >>> a
> >> Error: object 'a' not found
> >>
> >> Best,
> >> Serguei.
> >>
> >>
> >> Le 15/05/2017 à 10:39, Martin Maechler a écrit :
> >>>>>>>> Hervé Pagès <hpages at fredhutch.org>
> >>>>>>>> on Wed, 3 May 2017 12:08:26 -0700 writes:
> >>> > On 05/03/2017 12:04 PM, Hervé Pagès wrote:
> >>> >> Not sure why the performance penalty of nonstandard evaluation would
> >>> >> be more of a concern here than for something like switch().
> >>>
> >>> > which is actually a primitive. So it seems that there is at least
> >>> > another way to go than 'dots <- match.call(expand.dots=FALSE)$...'
> >>>
> >>> > Thanks, H.
> >>>
> >>> >>
> >>> >> If that can't/won't be fixed, what about fixing the man page so it's
> >>> >> in sync with the current behavior?
> >>> >>
> >>> >> Thanks, H.
> >>>
> >>> Being back from vacations,...
> >>> I agree that something should be done here, if not to the code than at
> >>> least to the man page.
> >>>
> >>> For now, I'd like to look a bit longer into a possible change to the function.
> >>> Peter mentioned a NSE way to fix the problem and you mentioned switch().
> >>>
> >>> Originally, stopifnot() was only a few lines of code and meant to be
> >>> "self-explaining" by just reading its definition, and I really would like
> >>> to not walk too much away from that original idea.
> >>> How did you (Herve) think to use switch() here?
> >>>
> >>>
> >>>
> >>> >> On 05/03/2017 02:26 AM, peter dalgaard wrote:
> >>> >>> The first line of stopifnot is
> >>> >>>
> >>> >>> n <- length(ll <- list(...))
> >>> >>>
> >>> >>> which takes ALL arguments and forms a list of them. This implies
> >>> >>> evaluation, so explains the effect that you see.
> >>> >>>
> >>> >>> To do it differently, you would have to do something like
> >>> >>>
> >>> >>> dots <- match.call(expand.dots=FALSE)$...
> >>> >>>
> >>> >>> and then explicitly evaluate each argument in turn in the caller
> >>> >>> frame. This amount of nonstandard evaluation sounds like it would
> >>> >>> incur a performance penalty, which could be undesirable.
> >>> >>>
> >>> >>> If you want to enforce the order of evaluation, there is always
> >>> >>>
> >>> >>> stopifnot(A) stopifnot(B)
> >>> >>>
> >>> >>> -pd
> >>> >>>
> >>> >>>> On 3 May 2017, at 02:50 , Hervé Pagès <hpages at fredhutch.org>
> >>> >>>> wrote:
> >>> >>>>
> >>> >>>> Hi,
> >>> >>>>
> >>> >>>> It's surprising that stopifnot() keeps evaluating its arguments
> >>> >>>> after it reaches the first one that is not TRUE:
> >>> >>>>
> >>> >>>> > stopifnot(3 == 5, as.integer(2^32), a <- 12) Error: 3 == 5 is
> >>> >>>> not TRUE In addition: Warning message: In stopifnot(3 == 5,
> >>> >>>> as.integer(2^32), a <- 12) : NAs introduced by coercion to integer
> >>> >>>> range > a [1] 12
> >>> >>>>
> >>> >>>> The details section in its man page actually suggests that it
> >>> >>>> should stop at the first non-TRUE argument:
> >>> >>>>
> >>> >>>> ‘stopifnot(A, B)’ is conceptually equivalent to
> >>> >>>>
> >>> >>>> { if(any(is.na(A)) || !all(A)) stop(...); if(any(is.na(B)) ||
> >>> >>>> !all(B)) stop(...) }
> >>> >>>>
> >>> >>>> Best, H.
> >>> >>>>
> >>> >>>> --
> >>> >>>> Hervé Pagès
> >>> >>>>
> >>> >>>> Program in Computational Biology Division of Public Health
> >>> >>>> Sciences Fred Hutchinson Cancer Research Center 1100 Fairview
> >>> >>>> Ave. N, M1-B514 P.O. Box 19024 Seattle, WA 98109-1024
> >>> >>>>
> >>> >>>> E-mail: hpages at fredhutch.org Phone: (206) 667-5791 Fax: (206)
> >>> >>>> 667-1319
> >>> >>>>
> >>> >>>> ______________________________________________
> >>> >>>> R-devel at r-project.org mailing list
> >>> >>>>
> >>> https://urldefense.proofpoint.com/v2/url?u=https-3A__stat.ethz.ch_mailman_listinfo_r-2Ddevel&d=DwIFaQ&c=eRAMFD45gAfqt84VtBcfhQ&r=BK7q3XeAvimeWdGbWY_wJYbW0WYiZvSXAJJKaaPhzWA&m=JwgKhKD2k-9Kedeh6pqu-A8x6UEV0INrcxcSGVGo3Tg&s=f7IKJIhpRNJMC3rZAkuI6-MTdL3GAKSV2wK0boFN5HY&e=
> >>> >>>>
> >>> >>>
> >>> >>
> >>>
> >>> > -- Hervé Pagès
> >>>
> >>> > Program in Computational Biology Division of Public Health Sciences
> >>> > Fred Hutchinson Cancer Research Center 1100 Fairview Ave. N,
> >>> > M1-B514 P.O. Box 19024 Seattle, WA 98109-1024
> >>>
> >>> > E-mail: hpages at fredhutch.org Phone: (206) 667-5791 Fax: (206)
> >>> > 667-1319
> >>>
> >>> > ______________________________________________
> >>> > R-devel at r-project.org mailing list
> >>> > https://stat.ethz.ch/mailman/listinfo/r-devel
> >>>
> >>> ______________________________________________
> >>> R-devel at r-project.org mailing list
> >>> https://stat.ethz.ch/mailman/listinfo/r-devel
> >>
>
> > ______________________________________________
> > R-devel at r-project.org mailing list
> > https://stat.ethz.ch/mailman/listinfo/r-devel
>
More information about the R-devel
mailing list