Capture errors, warnings and messages

In my last video I tried to add a feature to my {loud} package (more info here) and I succeeded. But in succeeding in realised that I would need to write a bit more code than what I expected. To make a long story short: it is possible to capture errors using purrr::safely():

library(purrr)
safe_log <- safely(log)

a <- safe_log("10")

str(a)

## List of 2
##  $ result: NULL
##  $ error :List of 2
##   ..$ message: chr "non-numeric argument to mathematical function"
##   ..$ call   : language .Primitive("log")(x, base)
##   ..- attr(*, "class")= chr [1:3] "simpleError" "error" "condition"

a is now a list with elements $result and $error. If everything goes right, $result holds the result of the operation, and if everything goes wrong, $result is NULL but $error now contains the error message. This is especially useful in non-interactive contexts. There is another similar function in {purrr} called quietly(), which captures warnings and messages:

quiet_log <- quietly(log)

b <- quiet_log(-10)

str(b)

## List of 4
##  $ result  : num NaN
##  $ output  : chr ""
##  $ warnings: chr "NaNs produced"
##  $ messages: chr(0)

as you can see, providing a negative number to log() does not cause an error, but simply a warning. A result of NaN is returned (you can try with log(-10) in your console). quietly() captures the warning message and returns a list of 4 elements, $result, $output, $warnings and $messages. The problem here, is that:

safe_log(-10)

## Warning in .Primitive("log")(x, base): NaNs produced

## $result
## [1] NaN
## 
## $error
## NULL

returns something useless: $result is NaN (because that’s what log() returns for negative numbers) but $error is NULL since no error was thrown, but only a warning! We have a similar problem with quiet_log():

quiet_log("10")

Error in .Primitive("log")(x, base) : 
  non-numeric argument to mathematical function

here, the error message is thrown, but not captured, since quietly() does not capture error messages.

So, are we back to square one? Not necessarily, since you could compose both functions:

pure_log <- quietly(safely(log))

a2 <- pure_log(-10)

str(a2)

## List of 4
##  $ result  :List of 2
##   ..$ result: num NaN
##   ..$ error : NULL
##  $ output  : chr ""
##  $ warnings: chr "NaNs produced"
##  $ messages: chr(0)

b2 <- pure_log("10")

str(b2)

## List of 4
##  $ result  :List of 2
##   ..$ result: NULL
##   ..$ error :List of 2
##   .. ..$ message: chr "non-numeric argument to mathematical function"
##   .. ..$ call   : language .Primitive("log")(x, base)
##   .. ..- attr(*, "class")= chr [1:3] "simpleError" "error" "condition"
##  $ output  : chr ""
##  $ warnings: chr(0) 
##  $ messages: chr(0)

As you can see, in the case of a2, the warning was captured, and in the case of b2 the error was captured. The problem, is that the resulting object is quite complex. It’s a list where $result is itself a list in case of a warning, or $error is a list in case of an error.

I tried to write a function that would decorate a function (as do safely() and quietly()), which in turn would then return a simple list and capture, errors, warnings and messages. I came up with this code, after re-reading Advanced R, in particular this chapter:

purely <- function(.f){

  function(..., .log = "Log start..."){

    res <- rlang::try_fetch(
                    rlang::eval_bare(.f(...)),
                    error = function(err) err,
                    #rlang_error = function(rlerr) rlerr,
                    warning = function(warn) warn,
                    message = function(message) message,
                    )

    final_result <- list(
      result = NULL,
      log = NULL
    )

    final_result$result <- if(any(c("error", "rlang_error", "warning", "message") %in% class(res))){
                             NA
                           } else {
                             res
                           }

    final_result$log <- if(any(c("error", "rlang_error", "warning", "message") %in% class(res))){
                          #res$message
                          purrr::pluck(res, "message", .default = "undefined error")
                        } else {
                          NA
                        }
    final_result
  }
}

f_m <- function(x){
  message("this is a message")
  str(x)
}

f_w <- function(x){
  warning("this is a warning")
  str(x)

}

f_e <- function(){
  stop("This is an error")

}

pure_fm <- purely(f_m)
pure_fw <- purely(f_w)
pure_fe <- purely(f_e)

Messages get captured:

pure_fm(10) |>
  str()

## List of 2
##  $ result: logi NA
##  $ log   : chr "this is a message\n"

as do warnings:

pure_fw(10) |>
  str()

## List of 2
##  $ result: logi NA
##  $ log   : chr "this is a warning"

as do errors:

pure_fe() |>
  str()

## List of 2
##  $ result: logi NA
##  $ log   : chr "This is an error"

The structure of the result is always $result and $log. In case everything goes well $result holds the result:

pure_log <- purely(log)

pure_log(c(1,10))

## $result
## [1] 0.000000 2.302585
## 
## $log
## [1] NA

And another example, with a more complex call:

pure_mean <- purely(mean)

pure_mean(c(1,10, NA), na.rm = TRUE)

## $result
## [1] 5.5
## 
## $log
## [1] NA

But in case something goes wrong, the error message will get captured.

suppressPackageStartupMessages(library(dplyr))

## {paint} masked print.tbl_df

pure_select <- purely(select)

Let’s try here to select a column that does not exist:

clean_mtcars <- mtcars %>%
  pure_select(hp, am, bm) #bm does not exist

str(clean_mtcars)

## List of 2
##  $ result: logi NA
##  $ log   : chr ""

Compare to what happens with select():

clean_mtcars2 <- mtcars %>%
  select(hp, am, bm) #bm does not exist

Error in `select()`:
! Can't subset columns that don't exist.
✖ Column `bm` doesn't exist.
Backtrace:
  1. mtcars %>% select(hp, am, bm)
...
...

purely(group_by)(mtcars, bm)

## $result
## [1] NA
## 
## $log
##                                             
## "Must group by variables found in `.data`."

suppressPackageStartupMessages(library(loud))

loud_sqrt <- loudly(sqrt)
loud_mean <- loudly(mean)
loud_exp <- loudly(exp)


result_pipe <- -1:-10 |>
  loud_mean() %>=% # This results in a negative number...
  loud_sqrt() %>=% # which sqrt() does not know how to handle
  loud_exp()

result_pipe

## $result
## NULL
## 
## $log
## [1] "Log start..."                                                                                                                                                            
## [2] "✔ mean(-1:-10) started at 2022-03-13 14:17:30 and ended at 2022-03-13 14:17:30"                                                                                          
## [3] "✖ CAUTION - ERROR: sqrt(.l$result) started at 2022-03-13 14:17:30 and failed at 2022-03-13 14:17:30 with following message: NaNs produced"                               
## [4] "✖ CAUTION - ERROR: exp(.l$result) started at 2022-03-13 14:17:30 and failed at 2022-03-13 14:17:30 with following message: non-numeric argument to mathematical function"