How to suppress warnings globally in a R package function-CodePudding

This is an update to an old question, How to suppress warnings globally in an R Script

where the solution was like using

    warn <- options(warn=-1)
    on.exit(options(warn))

But now CRAN says that options(warn=-1) is not allowed and says to use suppressWarnings() instead. My package was rejected because of this. But that doesn't work globally. What can be done?

CodePudding user response：

You could put the entire body of your function inside a suppressWarnings() block, e.g.

foo <- function(a,b,c) {
  ret_values <- suppressWarnings({
    ## body of the function goes here
  })
  return(ret_values)
}

This is is a hack (among other things, it will make source-level debugging harder), the original options()/on.exit(options(...)) solution is better, but if CRAN doesn't like it you're stuck.

If you just want to prevent a particular function call from issuing a warning (according to your comments above, it's chol() in your case), then suppressWarnings(chol(...)) should work, and should be better than the brute-force solution suggested above (based on this commit it looks like you've already implemented this ...)

It would be even better to be able to trap only specific warnings: e.g. sqrt(-1) and sqrt(10000000000000000000000L) return different warnings, one might want to trap the "NaNs produced" warning and not the "non-integer value qualified with L" warning. Unfortunately for reasons explained on the r-devel mailing list in 2012 (i.e., warning messages may be translated so you can't use text-matching on the message), there's (AFAIK) no reliable way to do this.

CodePudding user response：

In my use case, the solution is just to trap the call to chol() that will give warnings.

ellipsoid <- function(center, 
                      shape, 
                      radius=1, 
                      segments=60, 
                      warn.rank=FALSE){

    # adapted from the shapes3d demo in the rgl package and from the Rcmdr package
    degvec <- seq(0, 2*pi, length=segments)
    ecoord2 <- function(p) c(cos(p[1])*sin(p[2]), 
                             sin(p[1])*sin(p[2]), 
                             cos(p[2]))
    v <- t(apply(expand.grid(degvec,degvec), 1, ecoord2))
    # if (!warn.rank){
    #   warn <- options(warn=-1)
    #   on.exit(options(warn))
    # }
    if (warn.rank) {
    Q <- chol(shape, pivot=TRUE)
    }
    else {
      Q <- suppressWarnings(chol(shape, pivot=TRUE))
    }
    order <- order(attr(Q, "pivot"))
    v <- center   radius * t(v %*% Q[, order])
    v <- rbind(v, rep(1,ncol(v))) 
    e <- expand.grid(1:(segments-1), 1:segments)
    i1 <- apply(e, 1, function(z) z[1]   segments*(z[2] - 1))
    i2 <- i1   1
    i3 <- (i1   segments - 1) %% segments^2   1
    i4 <- (i2   segments - 1) %% segments^2   1
    i <- rbind(i1, i2, i4, i3)
    x <- asEuclidean(t(v))
    ellips <- qmesh3d(v, i)
    return(ellips)
}