[Rd] stopifnot() suggestion
Dan Davison
davison at uchicago.edu
Wed Mar 1 23:24:22 CET 2006
On Wed, 1 Mar 2006, Roger D. Peng wrote:
> Wouldn't it be better to do something like
>
> stopifnot(all(!is.na(x)), all(!is.na(y)), x, y)
>
> rather than have stopifnot() go checking for NAs? I agree the message is
> strange but if having non-NA values is really a condition, then why not just
> put it in the call to stopifnot()?
>
> -roger
>
I was thinking of a fallible R user accidentally testing the truth of an
expression with NAs, rather than of a situation where you remember that
there may be missing values. For example
> f <- function() { x <- NA ; if(x != 4) stop("x should be 4") }
> g <- function() { x <- NA ; stopifnot(x == 4) }
> f()
Error in if (x != 4) stop("x should be 4") :
missing value where TRUE/FALSE needed
> g()
Error in if (!(is.logical(r <- eval(ll[[i]])) && all(r)))
stop(paste(deparse(mc[[i + :
missing value where TRUE/FALSE needed
If you write the error-checking code represented by f(), you get a message
which is very helpful in correcting your error. But someone who uses
stopifnot() instead gets the output of g(). Even a user who knows the
origin of the code in the error message doesn't know which of several
stopifnot()s is responsible.
Dan
> Dan Davison wrote:
>> If an expression is passed to stopifnot() which contains missing values,
>> then the resulting error message is somewhat baffling until you are used to
>> it, e.g.
>>
>>> x <- y <- rep(TRUE, 10)
>>> y[7] <- NA
>>> stopifnot(x, y)
>> Error in if (!(is.logical(r <- eval(ll[[i]])) && all(r)))
>> stop(paste(deparse(mc[[i + :
>> missing value where TRUE/FALSE needed
>>
>> A minor change to stopifnot() produces the following behaviour:
>>
>>> stopifnot(x, y)
>> Error in stopifnot(x, y) : y contains missing values
>>
>> My attempt at a suitable modification follows, and below that the original
>> function definition. Is a change along these lines appropriate?
>>
>> ## Altered version
>>
>> stopifnot <- function (...) {
>> n <- length(ll <- list(...))
>> if (n == 0)
>> return(invisible())
>> mc <- match.call()
>> for (i in 1:n) {
>> if(any(is.na(r <- eval(ll[[i]])))) stop(paste(deparse(mc[[i +
>> 1]])), " contains missing values")
>> if (!(is.logical(r) && all(r)))
>> stop(paste(deparse(mc[[i + 1]]), "is not TRUE"), call. =
>> FALSE)
>> }
>> }
>>
>>
>> ## from R-2.1.1/src/library/base/R/stop.R
>>
>> stopifnot <- function(...)
>> {
>> n <- length(ll <- list(...))
>> if(n == 0)
>> return(invisible())
>> mc <- match.call()
>> for(i in 1:n)
>> if(!(is.logical(r <- eval(ll[[i]])) && all(r)))
>> stop(paste(deparse(mc[[i+1]]), "is not TRUE"), call. = FALSE)
>> }
>>
>>
>> Thanks,
>>
>> Dan
>>
>>
>>> version
>> _
>> platform i386-pc-linux-gnu
>> arch i386
>> os linux-gnu
>> system i386, linux-gnu
>> status
>> major 2
>> minor 2.0
>> year 2005
>> month 10
>> day 06
>> svn rev 35749
>> language R
>>
>> ----------
>> Dan Davison
>> Committee on Evolutionary Biology
>> University of Chicago, U.S.A.
>>
>> ______________________________________________
>> R-devel at r-project.org mailing list
>> https://stat.ethz.ch/mailman/listinfo/r-devel
>>
>
> --
> Roger D. Peng | http://www.biostat.jhsph.edu/~rpeng/
>
More information about the R-devel
mailing list