Using purrr::possibly to catch dynamic error messages

Question

I've written a custom function that does a number of checks and throws a different error when a check fails. Below is a simple example function that takes a data.frame and a column name and simply outputs the sum of that column. I'm using purrr::possibly() to create a saver version of that function so that I can loop over a vector of column names.

foo <- function(df, var){     

  #check 1  
if(var %in% names(df) == FALSE){
    stop(paste0("No column with name ", var, " found."))}  

  #check 2
if(all(is.na(dplyr::select(df, {{var}})))) {
   stop(paste0("All values of column ", var, " are missing."))}
  
  # main function  
  result <- df %>% 
    dplyr::rename(var = {{var}}) %>%
    dplyr::summarise(sum = sum(var))

#print(result) printing shows the correct error messages   
}

safer_foo <- purrr::possibly(.f = foo, otherwise = "error", quiet = FALSE)

I use purrr::map to loop over a vector of columns and store the output in a list. However, for elements where the function fails, I would like to store the specific error message instead of the static input of the "otherwise" argument of purrr::possibly requires. Replacing purrr::possibly with purrr::safely actually captures the specific error message as intended in the $error element of the list but I would like to avoid the extra nested level that safely creates.

test_df <- tibble(A = 1:10, C = NA)
input <- c("A", "B", "C")

output_list <- map(input, ~safer_foo(test_df, .x)) %>% set_names(input)

Output

> output_list

    sum
  <int>
1    55

$B
[1] "error"

$C
[1] "error"

Desired output

> output_list

    sum
  <int>
$A   55

$B
[1] "Error: No column with name B found."

$C
[1] "Error: All values of column C are missing."

Answer 1

You could tweak purrr::possibly() from its original code to return instead of message the error.

Original code:

## > possibly
## function (.f, otherwise, quiet = TRUE) 
## {
##     .f <- as_mapper(.f)
##     force(otherwise)
##     function(...) {
##         tryCatch(.f(...), error = function(e) {
##             if (!quiet) 
##                 message("Error: ", e$message) ## <--- tweak
##             otherwise
##         }, interrupt = function(e) {
##             stop("Terminated by user", call. = FALSE)
##         })
##     }
## }

tweaked function:

possibly2 <- function (.f, otherwise, quiet = TRUE) {
    .f <- as_mapper(.f)
    force(otherwise)
    function(...) {
        tryCatch(.f(...), error = function(e) {
            if (!quiet) 
                return(e$message) ## <-- tweaked
            otherwise
        }, interrupt = function(e) {
            stop("Terminated by user", call. = FALSE)
        })
    }
}

Example:

safer_foo <- possibly2(.f = foo, otherwise = "error",
                       quiet = FALSE ## don't forget to "unquiet"
                       )

## all other objects / code as in your example

Output:

## > output_list
## $A
## # A tibble: 1 x 1
##     sum
##   <int>
## 1    55
## 
## $B
## [1] "No column with name B found."
## 
## $C
## [1] "All values of column C are missing."

edit

Actually, possibly2 carries over code which is no longer needed. Omitting the unwanted static arguments otherwise and quiet, and skipping the handler for user interrupts, the required code shrinks down to:

possibly2 <- function (.f) {
    .f <- as_mapper(.f)
    function(...) {
        tryCatch(.f(...), error = function(e)  e$message)
    }
}