Catch warnings from functions in R and still get their return-value?

Within a function I'm calling another calculation-invensive foreign function, which triggers warnings in some situation, but also returns a value, which I'd like to evaluate, regardless whether warnings occurred or not.

Additionally, if warnings or errors occurred, I want to catch the warning/error messages for further processing.

The following R code demonstrates my intention:

hurz <- function(x) {
  # HINT: max(x) triggers a warning when x = NULL
  max(x)
  return(12345)
}

laus <- function(x) {
  r <- tryCatch({
      list(value = hurz(x), error_text = "No error.")
    }, warning = function(e) {
      error_text <- paste0("WARNING: ", e)
      # ugly hack to get the result while still catching the warning
      return(list(value = (suppressWarnings(hurz(5))), error_text = error_text))
    }, error = function(e) {
      error_text <- paste0("ERROR: ", e)
      return(list(value = NA, error_text = error_text))
    }, finally = {
    }, quiet = TRUE)
  return(r)
}

When errors occurr, the code ends up in the error-catch section, so it is obvious that I won't be able to get the return-value from hurz().

However, there seems to be no nice way to simultaneously get

the return-value of hurz() as well as
the warning produced.

When calling laus(3) I get the following response:

$value
[1] 12345

$error_text
[1] "No error."

On the other hand, when calling laus(NULL) I get:

[1] 12345

$error_text
[1] "WARNING: simpleWarning in max(x): no non-missing arguments to max; returning -Inf\n"

Of course calling hurz() wrapped with the suppressWarnings as shown above would be a really ugly hack and is no option, since hurz() performs very calculation-intensive work.

Does anyone have a clue how to solve this issue in a nice way and how I can catch warnings AND still get the fuction's return-value in one go?

Solution

Borrowing some poorly documented R magic demonstrated in this post, I think the following revised laus() function will do the trick:

laus <- function(x) {
  r <- 
    tryCatch(
      withCallingHandlers(
        {
          error_text <- "No error."
          list(value = hurz(x), error_text = error_text)
        }, 
        warning = function(e) {
          error_text <<- trimws(paste0("WARNING: ", e))
          invokeRestart("muffleWarning")
        }
      ), 
      error = function(e) {
        return(list(value = NA, error_text = trimws(paste0("ERROR: ", e))))
      }, 
      finally = {
      }
    )
  
  return(r)
}

Now I can call laus(3) and get:

$value
[1] 12345

$error_text
[1] "No error."

or laus(NULL) and get:

$value
[1] 12345

$error_text
[1] "WARNING: simpleWarning in max(x): no non-missing arguments to max; returning -Inf"

or laus(foo) and get:

$value
[1] NA

$error_text
[1] "ERROR: Error in hurz(x): object 'foo' not found"

Note the use of <<- in the warning function. This searches the enclosing frames of the warning function and overwrites the error_text value in the environment of the anonymous function that calls hurz.

I had to use a debugger with a breakpoint in the warning function to figure out the enclosing frames. If you don't understand environments and frames in R, just trust that using <<- in this context will overwrite that error_text variable that is initialized to "No error."

To understand this code a bit better, realize that withCallingHandlers() is itself a stand-alone function. This is illustrated by the following variation of the function, which will trap and recover from warnings, but will NOT handle errors:

lausOnlyHandleWarnings <- function(x) {
  r <- 
    withCallingHandlers(
      {
        error_text <- "No error."
        list(value = hurz(x), error_text = error_text)
      }, 
      warning = function(e) {
        error_text <<- trimws(paste0("WARNING: ", e))
        invokeRestart("muffleWarning")
      }
    )
  
  return(r)
}

The output from this function will be identical to the laus() function, unless there is an error. In the case of an error, it will simply fail and report the error, as would any other function that lacks a tryCatch. For instance, lausOnlyHandleWarnings(foo) yields:

Error in hurz(x) : object 'foo' not found