R tryCatch but retain the expression result in the case of a warning

Question

I have a long running function that might generate warnings in some cases. When it does, I want to keep the result of the function, but add some diagnostic info to the result.

Something like this

x = tryCatch(
    someLongRunningFunctionThatMightGenerateWarnings(),
    warning = function(w){
        c(w$exprResult, list(diagnostics = "some useful info"))
    }
)

Is there any way to accomplish this with tryCatch without evaluating the expression for a second time in the warning handler?

Greg · Accepted Answer

Here's a base solution with a custom function myCatch(), which has a form similar to tryCatch() (and identical to withCallingHandlers()). Feel free to adapt it, especially in the areas designated by my # ADAPT... comments.

By request, I have also Updated myCatch() to accept a user-defined function custom_fun. Based on the result from expr, custom_fun will process any warning object thrown when evaluating expr, and its output will be returned as diagnostics (alongside results).

myCatch <- function(# The expression to execute.
                    expr,
                    # Further arguments to tryCatch().
                    ...,
                    # User-defined function to extract diagnostic info from
                    # warning object, based on output that resulted from expr.
                    custom_fun = function(result, w){return(w)}) {
  ######################
  ## Default Settings ##
  ######################
  
  # Defaults to NULL results and empty list of diagnostics.
  DEFAULT_RESULTS <- NULL
  DEFAULT_DIAGNOSTICS <- NULL
  
  # Defaults to standard R error message, rather than a ponderous traceback
  # through the error handling stacks themselves; also returns the error object
  # itself as the results.
  DEFAULT_ERROR <- function(e){
    message("Error in ", deparse(e$call), " : ", e$message)
    return(e)
  }
  
  
  ################
  ## Initialize ##
  ################
  
  # Initialize output to default settings.
  res <- DEFAULT_RESULTS
  diag <- DEFAULT_DIAGNOSTICS
  err <- DEFAULT_ERROR
  
  # Adjust error handling if specified by user.
  if("error" %in% names(list(...))) {
    err <- list(...)$error
  }
  
  
  #######################
  ## Handle Expression ##
  #######################
  
  res <- tryCatch(
    expr = {
      withCallingHandlers(
        expr = expr,
        # If expression throws a warning, record diagnostics without halting,
        # so as to store the result of the expression.
        warning = function(w){
          parent <- parent.env(environment())
          parent$diag <- w
        }
      )
    },
    error = err,
    ...
  )
  
  
  ############
  ## Output ##
  ############
  
  # Package the results as desired.
  return(list(result = res,
              diagnostics = custom_fun(res, diag)))
}

Application

For your purposes, use myCatch() like so

x <- myCatch(someLongRunningFunctionThatMightGenerateWarnings())

or more generally

x <- myCatch(expr = {
               # ...
               # Related code.
               # ...
               someLongRunningFunctionThatMightGenerateWarnings()
             },
             # ...
             # Further arguments like 'finally' to tryCatch().
             # ...
             custom_fun = function(result, w){
                                             # ...
                                             # Extract warning info from 'w'.
                                             # ...
                                             })

and feel free to customize error or finally as you would with tryCatch(). If you do customize warning, your diagnostics will still be preserved in the output, but you will lose your intended output for result (which will instead become the return value you specified in warning).

If we followed your specific example here, and used myCatch() like so

output <- myCatch(
  log(-5),
  custom_fun = function(result, w){paste(as.character(result), "with warning", w$message)}
)
output

then R would display the warning message

Warning message:
In log(-5) : NaNs produced

and give us the following output:

$result
[1] NaN

$diagnostics
[1] "NaN with warning NaNs produced"

Further Examples

When we apply myCatch() to certain example expressions, using simply the default for custom_fun, here are the results:

Normal

output_1 <- myCatch(expr = {log(2)},
                    finally = {message("This is just like using 'finally' for tryCatch().")})
output_1

will display the custom message

This is just like using 'finally' for tryCatch().

and give us the output:

$result
[1] 0.6931472

$diagnostics
NULL

Warning

output_2 <- myCatch(expr = {log(-1)})
output_2

will display the warning message

Warning message:
In log(-1) : NaNs produced

and give us the output:

$result
[1] NaN

$diagnostics

Error (Default)

output_3 <- myCatch(expr = {log("-1")})
output_3

will gracefully handle the error and display its message

Error in log("-1") : non-numeric argument to mathematical function

and still give us the output (with an error object for results):

$result


$diagnostics
NULL

Error (Custom)

output_4 <- myCatch(expr = {log("-1")}, error = function(e){stop(e)})
output_4

will kill myCatch() and immediately throw an error, with a ponderous traceback through the handling functions (here tryCatch()) within myCatch():

Error in log("-1") : non-numeric argument to mathematical function 

  6. stop(e) 
  5. value[[3L]](cond) 
  4. tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
         names[nh], parentenv, handlers[[nh]]) 
  3. tryCatchList(expr, classes, parentenv, handlers) 
  2. tryCatch(expr = {
         withCallingHandlers(expr = expr, warning = function(w) {
             parent <- parent.env(environment())
             parent$diag <- w ... 
  1. myCatch(expr = {
         log("-1")
     }, error = function(e) {
         stop(e) ...

Since myCatch() was interrupted, it returns no value to be stored in output_, which leaves us with

Error: object 'output_4' not found