How to Save Warnings and Errors as Output from a Function

How do I save warnings and errors as output from a function?

Maybe this is the same as your solution, but I wrote a factory to convert plain old functions into functions that capture their values, errors, and warnings, so I can

test <- function(i)
    switch(i, "1"=stop("oops"), "2"={ warning("hmm"); i }, i)
res <- lapply(1:3, factory(test))

with each element of the result containing the value, error, and / or warnings. This would work with user functions, system functions, or anonymous functions (factory(function(i) ...)). Here's the factory

factory <- function(fun)
    function(...) {
        warn <- err <- NULL
        res <- withCallingHandlers(
            tryCatch(fun(...), error=function(e) {
                err <<- conditionMessage(e)
                NULL
            }), warning=function(w) {
                warn <<- append(warn, conditionMessage(w))
                invokeRestart("muffleWarning")
            })
        list(res, warn=warn, err=err)
    }

and some helpers for dealing with the result list

.has <- function(x, what)
    !sapply(lapply(x, "[[", what), is.null)
hasWarning <- function(x) .has(x, "warn")
hasError <- function(x) .has(x, "err")
isClean <- function(x) !(hasError(x) | hasWarning(x))
value <- function(x) sapply(x, "[[", 1)
cleanv <- function(x) sapply(x[isClean(x)], "[[", 1)

Suppress, log and return values in a function with warnings in R

It turns out the solution is very simple, just use suppressWarnings outside will do the trick:

suppressWarnings(withCallingHandlers(expr = fn1(),
                    warning = function(w) {
                        message(paste0("saved to a file: ", w$message))
                        # write(w$message, "xxlocation")
                    },
                    finally = function(x) suppressWarnings(x)
))

saved to a file: this is a warning!
[1] 1

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

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

Store errors and warnings with tryCatch() in a list

Here's a version that puts the tryCatch within the loop, and saves the errors and warnings that were generated:

  hospitals_url <- "https://services1.arcgis.com/Hp6G80Pky0om7QvQ/arcgis/rest/services/Hospitals_1/FeatureServer/0/query?where=1%3D1&outFields=*&outSR=4326&f=json"
  hospitals_num <- c(0, 2000, 4000, 6000)
  hosp_e <- list()
  hosp_w <- list()
  
  hosget <- lapply(hospitals_num, function(num) {
    tryCatch({
      hospitals_url_loop <- paste(hospitals_url, "&resultOffset=", num)
      hospitals_json <- fromJSON(hospitals_url_loop)
      hospitals_df <- as.data.frame(hospitals_json$features$attributes)},
      error = function(e){
        hosp_e <<- c(hosp_e, list(e))
        print(e)},
      
      warning = function(w){
        hosp_w <<- c(hosp_w, list(w))
        print(w)}     
      ) })
    
  hospitals_df <- do.call(rbind, hosget)
  

I didn't adapt your finally code to this rearrangement; I'll leave that to you. But at the end, hosp_e will be a list holding all the errors, and hosp_w will be a list holding all the warnings.

How to write errors and warnings to a log file?

I'm sure of all of the pitfalls, I've read some people having trouble with sink not releasing file access to a log file, and you could potentially forget to reset sink to output back to console instead of the log file, which could potentially corrupt your log file. But you should be able to generate an error log by running your code to download the files through a try-catch block and writing out the error messages similar to below.

log.path <- # Path to log file

tryCatch({
  # Code to attempt
  log(q)

}, error = function(err.msg){
             # Add error message to the error log file
             write(toString(err.msg), log.path, append=TRUE)
          }
)

Capture message, warnings, and errors into web api in R

Following the suggestion for this question: How do I save warnings and errors as output from a function?.

Now I can capture the message, warning, error using tryCatch and store the log type and time in a list.

factory <- function(fun) {
    function(...) {
        warn <- err <- msg <- NULL
        res <- withCallingHandlers(
            tryCatch(fun(...), error=function(e) {
                new_e <- err
                new_e[[length(new_e) + 1]]  <- list(time = Sys.time(),
                                                    type = "error",
                                                    log =  conditionMessage(e))
                err <<- new_e
                NULL
            }), warning=function(w) {
                new_w <- warn
                new_w[[length(new_w) + 1]]  <- list(time = Sys.time(),
                               type = "warning",
                               log =  conditionMessage(w))

                warn <<- new_w
                invokeRestart("muffleWarning")
            }, message = function(m) {
                new_w <- msg
                new_w[[length(new_w) + 1]]  <- list(time = Sys.time(),
                                                    type = "message",
                                                    log =  conditionMessage(m))
                msg <<- new_w

                invokeRestart("muffleMessage")
            })
        list(res, warn=warn, err=err, msg=msg)
    }

}
test <- function(){
    print("AAAAAAA")
    message("BBBBBB")
    print("CCCC")
    warning("DDDDDDDDDDD")
    Sys.sleep(1)
    warning("EEEEEEEEEEEEEEE")
    #stop("FFFFFFFFFFFFF")
    warning("GGGGGGGGGGGGGG")
    return(NULL)

}

a <- factory(test)()

The results are shown below

> a
[[1]]
NULL

$warn
$warn[[1]]
$warn[[1]]$`time`
[1] "2019-10-21 22:02:39 AEST"

$warn[[1]]$type
[1] "warning"

$warn[[1]]$log
[1] "DDDDDDDDDDD"


$warn[[2]]
$warn[[2]]$`time`
[1] "2019-10-21 22:02:40 AEST"

$warn[[2]]$type
[1] "warning"

$warn[[2]]$log
[1] "EEEEEEEEEEEEEEE"


$warn[[3]]
$warn[[3]]$`time`
[1] "2019-10-21 22:02:40 AEST"

$warn[[3]]$type
[1] "warning"

$warn[[3]]$log
[1] "GGGGGGGGGGGGGG"



$err
NULL

$msg
$msg[[1]]
$msg[[1]]$`time`
[1] "2019-10-21 22:02:39 AEST"

$msg[[1]]$type
[1] "message"

$msg[[1]]$log
[1] "BBBBBB\n"

In the next step, I can use httr function to call RESTAPI to store the logs in the database. Alternatively, the message can be directly stored into database when the messages are generated through updating the factory function.

The only problem is the function cannot capture print and cat. However, this question Why is message() a better choice than print() in R for writing a package? suggestion message function is better than print and cat functions. It might be not a big issue for current stage.

Throw warnings rather than errors in testthat

In the absence of an approach specific to testthat you could use general error handling to output a warning in place of an error.

expect_equal_or_warn <- function(...) tryCatch(expect_equal(...),
                                               error = function(e) warning(e))

expect_equal_or_warn(add_x_y(2,2), 3)

Warning message:
add_x_y(2, 2) not equal to 3.
1/1 mismatches
[1] 4 - 3 == 1 

---

Related Topics