For anyone who will come around the same issue, here is a workaround:
safe_mclapply <- function(X, FUN, mc.cores, stop.on.error=T, ...){
fun <- function(x){
res_inner <- tryCatch({
withCallingHandlers(
expr = {
FUN(x, ...)
},
warning = function(e) {
message_parallel(trimws(paste0("WARNING [element ", x,"]: ", e)))
# this line is required to continue FUN execution after the warning
invokeRestart("muffleWarning")
},
error = function(e) {
message_parallel(trimws(paste0("ERROR [element ", x,"]: ", e)))
}
)},
error = function(e){
# error is returned gracefully; other results of this core won't be affected
return(e)
}
)
return(res_inner)
}
res <- mclapply(X, fun, mc.cores=mc.cores)
failed <- sapply(res, inherits, what = "error")
if (any(failed == T)){
error_indices <- paste0(which(failed == T), collapse=", ")
error_traces <- paste0(lapply(res[which(failed == T)], function(x) x$message), collapse="\n\n")
error_message <- sprintf("Elements with following indices failed with an error: %s. Error messages: \n\n%s",
error_indices,
error_traces)
if (stop.on.error)
stop(error_message)
else
warning(error_message, "\n\n### Errors will be ignored ###")
}
return(res[!failed])
}
#' Function which prints a message using shell echo; useful for printing messages from inside mclapply when running in Rstudio
message_parallel <- function(...){
system(sprintf('echo "\n%s\n"', paste0(..., collapse="")))
}
safe_mclapply
above is a wrapper around mclapply
. For each iteration it uses withCallingHandlers
to catch and print warnings and errors; note that invokeRestart("muffleWarning")
is required in order to continue FUN
exection and return the result. Printing is done via message_parallel
function which uses shell echo
to print messages to R console (tested to work in Rstudio).
safe_mclapply
provides few more features which you might find optional:
- along with the warning and error it prints character representation of
x
which I find useful because it gives an idea where the message comes from
tryCatch
around withCallingHandlers
helps to return an error gracefully so that other results of the core are not affected
- after
mclapply
is executed, the indices of error results are printed
stop.on.error
provides an option to ignore any results which contain error and continue despite the errors
Side note: I personally prefer pbmclapply
function from pbmcapply over mclapply
which adds a progress bar. You can change mclapply
to pbmclapply
in the code above.
Small snippet to test the code:
X <- list(1, 2, 3, 4, 5, 6)
f <- function(x){
if (x == 3){
warning("a warning")
warning("second warning")
}
if (x == 6){
stop("an error")
}
return(x + 1)
}
res <- safe_mclapply(X = X, FUN = f, mc.cores=16)
res_no_stop <- safe_mclapply(X = X, FUN = f, mc.cores=16, stop.on.error = F)