tryCatch and "promise already under evaluation" [duplicate] - r

Question

I'm using lapply to run a complex function on a large number of items, and I'd like to save the output from each item (if any) together with any warnings/errors that were produced so that I can tell which item produced which warning/error.
I found a way to catch warnings using withCallingHandlers (described here). However, I need to catch errors as well. I can do it by wrapping it in a tryCatch (as in the code below), but is there a better way to do it?
catchToList <- function(expr) {
val <- NULL
myWarnings <- NULL
wHandler <- function(w) {
myWarnings <<- c(myWarnings, w$message)
invokeRestart("muffleWarning")
}
myError <- NULL
eHandler <- function(e) {
myError <<- e$message
NULL
}
val <- tryCatch(withCallingHandlers(expr, warning = wHandler), error = eHandler)
list(value = val, warnings = myWarnings, error=myError)
}
Sample output of this function is:
> catchToList({warning("warning 1");warning("warning 2");1})
$value
[1] 1
$warnings
[1] "warning 1" "warning 2"
$error
NULL
> catchToList({warning("my warning");stop("my error")})
$value
NULL
$warnings
[1] "my warning"
$error
[1] "my error"
There are several questions here on SO that discuss tryCatch and error handling, but none that I found that address this particular issue. See How can I check whether a function call results in a warning?, warnings() does not work within a function? How can one work around this?, and How to tell lapply to ignore an error and process the next thing in the list? for the most relevant ones.

Answer 1

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)

Answer 2

Try the evaluate package.
library(evaluate)
test <- function(i)
switch(i, "1"=stop("oops"), "2"={ warning("hmm"); i }, i)
t1 <- evaluate("test(1)")
t2 <- evaluate("test(2)")
t3 <- evaluate("test(3)")
It currently lacks a nice way of evaluating expression though - this is mainly because it's targetted towards reproducing exactly what R output's given text input at the console.
replay(t1)
replay(t2)
replay(t3)
It also captures messages, output to the console, and ensures that everything is correctly interleaved in the order in which it occurred.

Answer 3

I have merged Martins soulution (https://stackoverflow.com/a/4952908/2161065) and the one from the R-help mailing list you get with demo(error.catching).
The main idea is to keep both, the warning/error message as well as the command triggering this problem.
myTryCatch <- function(expr) {
warn <- err <- NULL
value <- withCallingHandlers(
tryCatch(expr, error=function(e) {
err <<- e
NULL
}), warning=function(w) {
warn <<- w
invokeRestart("muffleWarning")
})
list(value=value, warning=warn, error=err)
}
Examples:
myTryCatch(log(1))
myTryCatch(log(-1))
myTryCatch(log("a"))
Output:
myTryCatch(log(1))
# $value
# [1] 0
#
# $warning
# NULL
#
# $error
# NULL
myTryCatch(log(-1))
# $value
# [1] NaN
#
# $warning
# <simpleWarning in log(-1): NaNs produced>
#
# $error
# NULL
myTryCatch(log("a"))
# $value
# NULL
#
# $warning
# NULL
#
# $error
# <simpleError in log("a"): non-numeric argument to mathematical function>

Answer 4

The purpose of my answer (and modification to Martin's excellent code) is so that the factory-ed function returns the data structure expected if all goes well. If a warning is experienced, it is attached to the result under the factory-warning attribute. data.table's setattr function is used to allow for compatibility with that package. If an error is experienced, the result is the character element "An error occurred in the factory function" and the factory-error attribute will carry the error message.
#' Catch errors and warnings and store them for subsequent evaluation
#'
#' Factory modified from a version written by Martin Morgan on Stack Overflow (see below).
#' Factory generates a function which is appropriately wrapped by error handlers.
#' If there are no errors and no warnings, the result is provided.
#' If there are warnings but no errors, the result is provided with a warn attribute set.
#' If there are errors, the result retutrns is a list with the elements of warn and err.
#' This is a nice way to recover from a problems that may have occurred during loop evaluation or during cluster usage.
#' Check the references for additional related functions.
#' I have not included the other factory functions included in the original Stack Overflow answer because they did not play well with the return item as an S4 object.
#' #export
#' #param fun The function to be turned into a factory
#' #return The result of the function given to turn into a factory. If this function was in error "An error as occurred" as a character element. factory-error and factory-warning attributes may also be set as appropriate.
#' #references
#' \url{http://stackoverflow.com/questions/4948361/how-do-i-save-warnings-and-errors-as-output-from-a-function}
#' #author Martin Morgan; Modified by Russell S. Pierce
#' #examples
#' f.log <- factory(log)
#' f.log("a")
#' f.as.numeric <- factory(as.numeric)
#' f.as.numeric(c("a","b",1))
factory <- function (fun) {
errorOccurred <- FALSE
library(data.table)
function(...) {
warn <- err <- NULL
res <- withCallingHandlers(tryCatch(fun(...), error = function(e) {
err <<- conditionMessage(e)
errorOccurred <<- TRUE
NULL
}), warning = function(w) {
warn <<- append(warn, conditionMessage(w))
invokeRestart("muffleWarning")
})
if (errorOccurred) {
res <- "An error occurred in the factory function"
}
if (is.character(warn)) {
data.table::setattr(res,"factory-warning",warn)
} else {
data.table::setattr(res,"factory-warning",NULL)
}
if (is.character(err)) {
data.table::setattr(res,"factory-error",err)
} else {
data.table::setattr(res, "factory-error", NULL)
}
return(res)
}
}
Because we don't wrap the result in an extra list we can't make the kind of assumptions that allow for some of his accessor functions, but we can write simple checks and decide how to handle the cases as is appropriate to our particular resulting data-structure.
.has <- function(x, what) {
!is.null(attr(x,what))
}
hasWarning <- function(x) .has(x, "factory-warning")
hasError <- function(x) .has(x, "factory-error")
isClean <- function(x) !(hasError(x) | hasWarning(x))