Run a function in tryCatch in case of error/warning - r

I'm using a tryCatch function in which I want another function to be run in case of error/warning. This other function depends on some arguments and for some reason, tryCatch does not recognize them when they are the error and warning functions.
Here is a simplified function where I'm facing the same problem:
essai <- function(x){
y <- 2
result <- tryCatch({
sqrt(x*y)
} , warning = function(cond,x,y) {
message(cond)
sqrt(abs(x*y))
} , error = function(cond,x,y) {
message(cond)
sqrt(abs(x*y))
} , finally = {
message("done")
} )
}
nbs <- c(1,2,3,-1,-2)
lapply(nbs, essai)
But here I have an error message saying Error in value[[3L]](cond) : argument "x" is missing, with no default. R doesn't understand it has to reuse x and y used in the failed function, why?

error and warning take functions of one argument. This works fine:
essai <- function(x, cond = 'problem'){
y <- 2
result <- tryCatch({
sqrt(x*y)
} , warning = function(w) {
message(cond)
sqrt(abs(x*y))
} , error = function(e) {
message(cond)
sqrt(abs(x*y))
} , finally = {
message("done")
} )
}
The rest of the arguments can be specified in your essai function and will be available from both warning and error.
nbs <- c(1,2,3,-1,-2)
lapply(nbs, essai)
#done
#done
#done
#problem
#done
#problem
#done
# [[1]]
# [1] 1.414214
#
# [[2]]
# [1] 2
#
# [[3]]
# [1] 2.44949
#
# [[4]]
# [1] 1.414214
#
# [[5]]
# [1] 2

Related

tryCatch within for loop

I am new to R and I have checked most links online but I have not been able to solve the problem.
Here is a reproducible example of a Monte Carlo simulation I am doing:
rm(list = ls())
x=c(-2,3,-1,4,'A')
y=rep(0,5)
for(i in 1:5){
tryCatch(
expr = {
y[i]=log(x[i])
},
error = function(e){
message('Caught an error!',i)
return(NA)
},
warning = function(w){
message('Caught an warning!',i)
return(NA)
}
)
}
Please how do I fix the code so that at the end of the for loop, R returns the values of y as
y= NA,log(3),NA,log(4),NA
i=1,3,5
and the values of i where there was an error or warning.
That is, error and warnings are replaced with NA and successful evaluations are returned and the values of i where there was an error or warning are also returned.
Thanks
Initialise y with NA and then run the for loop. Also since x is a vector and vector can hold only one class all the numbers in x turn to characters as you have non-numeric elements in x so you need to convert them to numbers before taking log.
x=c(-2,3,-1,4,'A')
y=rep(NA,5)
for(i in 1:5){
tryCatch(
expr = {
y[i]= log(as.numeric(x[i]))
},
error = function(e){
message('Caught an error!',i)
},
warning = function(w){
message('Caught a warning! ',i)
}
)
}
#Caught a warning! 1
#Caught a warning! 3
#Caught a warning! 5
y
#[1] NA 1.098612 NA 1.386294 NA
and then use is.na with which to get the index where error or warning happened.
which(is.na(y))
#[1] 1 3 5
Of course, you can do this without for loop as well
y <- log(as.numeric(x))
which(is.na(y))
#[1] 1 3 5
To return different value based on error or warning, we can make this into a function
run_fun <- function(x) {
tryCatch(
expr = {
return(log(as.numeric(x)))
},
error = function(e){
message('Caught an error!',i)
return(100)
},
warning = function(w){
message('Caught a warning! ',i)
return(200)
}
)
}
and then call it in for loop.
for (i in seq_along(x)) {
y[i] <- run_fun(x[i])
}
y
#[1] 200.0000 1.0986 200.0000 1.3863 200.0000

How to correctly log warnings and errors using `tryCatch` in R?

I have a function fun that often produces warnings and occasionally throws errors. I am trying to use tryCatch to log warnings and errors, as suggested in this answer. How can I simultaneously store the warnings and errors?
Here is a minimal setup:
# Function for warnings, errors.
fun <- function(i) {
# Print warnings as they come in.
options(warn = 1)
# Issue warning.
warning(paste("Warn.", i))
# Stop.
if(i == 3) { stop(paste("Err.", i)) }
# Restore warning default behaviour.
options(warn = 0)
}
Evaluating fun with tryCatch:
# Storage
warns = list()
errs = list()
# Try catch the function and log the warnings/ errors.
for (i in 1:4) {
tryCatch(fun(i),
warning = function(w) warns[[i]] <<- w,
error = function(e) errs[[i]] <<- e
)
}
However, the output shows that the error hasn't been stored.
warns
# [[1]]
# <simpleWarning in fun(i): Warn. 1>
#
# [[2]]
# <simpleWarning in fun(i): Warn. 2>
#
# [[3]]
# <simpleWarning in fun(i): Warn. 3>
#
# [[4]]
# <simpleWarning in fun(i): Warn. 4>
errs
# list()
Based on Ronak's helpful comment and the following question How do I save warnings and errors as output from a function?, the code can be simplified as follows:
# Storage.
warns = list()
errs = list()
# Example function.
fun <- function(i) {
# Issue warning.
warning(paste("Warn.", i))
# Stop.
if(i == 3) { stop(paste("Err.", i)) }
}
# Evaluate `fun`.
for (i in 1:4) {
tryCatch(withCallingHandlers(
expr = fun(i),
# Handle the warnings.
warning = function(w) {
warns <<- c(warns, list(w))
invokeRestart("muffleWarning")
}),
# Handle the errors.
error = function(e) {
errs <<- c(errs, list(e))
}
)
}
The output then looks like:
warns
# [[1]]
# <simpleWarning in fun(i): Warn. 1>
#
# [[2]]
# <simpleWarning in fun(i): Warn. 2>
#
# [[3]]
# <simpleWarning in fun(i): Warn. 3>
#
# [[4]]
# <simpleWarning in fun(i): Warn. 4>
errs
# [[1]]
# <simpleError in fun(i): Err. 3>
More information and links are provided in the question linked above.

tryCatch results in the same output regardless of error in R

I am trying to write an error exception handling in R using tryCatch.
correct = 1
tryCatch({
sqrt(b)
},
warning = function(w){
print("NaNs")
},
finally = {
correct = 0
}
)
correct
If I set b = -5, the warning is printed and the value of correct is 0. If I set b = 5, the warning is not printed. However the value is still 0. What I would like is that when there is some warning/error to catch, the value of correct is 0. When there is no warning/error, the value of correct is 1. Thanks!
You don't want finally here. Instead just specify return values of 0 when an error or warning occurs.
myfun <- function(b) {
tryCatch({
sqrt(b)
},
error = function(e){
return(0)
},
warning = function(w){
return(0)
}
)
}
> myfun(5)
# [1] 2.236068
> myfun(-5)
# [1] 0
Here is a function:
is.bad <- function(x) {
as.numeric(isTRUE(tryCatch(x,
error = function(c) TRUE,
warning = function(c) TRUE
)))
}
is.bad(stop())
is.bad(warning())
is.bad(message())
is.bad(3)
## > is.bad(stop())
## [1] 1
## > is.bad(warning())
## [1] 1
## > is.bad(message())
##
## [1] 0
## > is.bad(3)
## [1] 0
The finally clause is executed regardless of whether or not a warning is thrown in the square root. That's why you end up with correct == 0 regardless.
The following code will do what you want, although I used a global assignment <<- which might cause problems if you are not careful. This was necessary because otherwise you can't change the value of correct from within the warning function.
correct = 1
tryCatch({
sqrt(b)
},
warning = function(w){
print("NaNs")
correct <<- 0
}
)

Warnings suppressed with mclapply in R

With mclapply() all issued warnings seems get suppressed:
library(multicore)
mclapply(1:3, function(x) warning(x))
[[1]]
[1] "1"
[[2]]
[1] "2"
[[3]]
[1] "3"
while lapply would give:
lapply(1:3, function(x) warning(x))
[[1]]
[1] "1"
[[2]]
[1] "2"
[[3]]
[1] "3"
Warning messages:
1: In FUN(1:3[[3L]], ...) : 1
2: In FUN(1:3[[3L]], ...) : 2
3: In FUN(1:3[[3L]], ...) : 3
Any tips on how to avoid loosing the warnings?
According to mclapply's help page, in my opinion the argument mc.silent should allow you to chose if warnings are to be printed or not. Strangely, it does not do that. Setting it explictly to TRUE or FALSE does not have any effect in your situation.
So that leaves us only with a somewhat dirty hack: forcing R to print warnings as they occur.
options(warn=1)
mclapply(1:3, function(x) warning(x))
# Warning in FUN(1L[[1L]], ...) : 1
# Warning in FUN(2L[[1L]], ...) : 2
# Warning in FUN(3L[[1L]], ...) : 3
# [[1]]
# [1] "1"
#
# [[2]]
# [1] "2"
#
# [[3]]
# [1] "3"
I have this problem too. If I'm reading the code correctly, parallel::mclapply() passes the mc.silent option to parallel:mcparallel(). But mcparallel() has this line:
sendMaster(try(eval(expr, env), silent = TRUE))
I think that's the place where the warnings would be sent back to the master process, but the mc.silent is not respected. That's my best guess about what is going on.
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)

get stack trace on tryCatch'ed error in R

This is related to some other questions, but I can't seem to figure out how to apply the answer, so I'm asking a new question.
I'm trying to figure out an uninformative error from a piece of code that looks like this:
tryCatch(MainLoop(),
error=function(e) { fatal(lgr, paste('caught fatal error:', as.character(e)));
exit.status <<- 1 })
The problem is that the error appears to be related to something buried in a library function:
Error in nrow(x): (subscript) logical subscript too long
That nrow is not in my code, as the C-level error above only applies to a type of indexing that never happens in any of my nrow calls.
So I'd really like to get a stack trace from within that tryCatch. Here's an analogous problem:
x <- function() { y(); }
y <- function() { z(); }
z <- function() { stop("asdf") }
> x()
Error in z() : asdf
> tryCatch(x(), error=function(e) { print(conditionCall(e)) } )
z()
> tryCatch(x(), error=function(e) { dump.frames() } )
> last.dump
$`tryCatch(x(), error = function(e) {
dump.frames()
})`
<environment: 0x1038e43b8>
$`tryCatchList(expr, classes, parentenv, handlers)`
<environment: 0x1038e4c60>
$`tryCatchOne(expr, names, parentenv, handlers[[1]])`
<environment: 0x1038e4918>
$`value[[3]](cond)`
<environment: 0x1038ea578>
attr(,"error.message")
[1] "asdf"
attr(,"class")
[1] "dump.frames"
How do I get the stack trace that includes the call to y()? Do I have to stop using tryCatch? What's a better way?
For interactive use one might trace(stop, quote(print(sys.calls()))) to print the call stack at the time stop() is invoked.
From ?tryCatch,
The function 'tryCatch' evaluates its expression argument in a
context where the handlers provided in the '...' argument are
available.
whereas
Calling handlers are established by 'withCallingHandlers'...
the handler is called... in the context where the condition
was signaled...
so
> withCallingHandlers(x(), error=function(e) print(sys.calls()))
[[1]]
withCallingHandlers(x(), error = function(e) print(sys.calls()))
[[2]]
x()
[[3]]
y()
[[4]]
z()
[[5]]
stop("asdf")
[[6]]
.handleSimpleError(function (e)
print(sys.calls()), "asdf", quote(z()))
[[7]]
h(simpleError(msg, call))
Error in z() : asdf
This is thwarted if there is an inner tryCatch
withCallingHandlers({
tryCatch(x(), error=function(e) stop("oops"))
}, error=function(e) print(sys.calls()))
as we only have access to the call stack after the tryCatch has 'handled' the error.
Yes, it is possible. It is not too elegant in coding, but very helpful in output!
Any comments are welcome!
I put it in my misc package, use it from there if you want the documentation.
https://github.com/brry/berryFunctions/blob/master/R/tryStack.R
The next CRAN version is planned to be released soon, until then:
devtools::install_github("brry/berryFunctions")
# or use:
source("http://raw.githubusercontent.com/brry/berryFunctions/master/R/instGit.R")
instGit("brry/berryFunctions")
library(berryFunctions)
?tryStack
Here it is for fast reference:
tryStack <- function(
expr,
silent=FALSE
)
{
tryenv <- new.env()
out <- try(withCallingHandlers(expr, error=function(e)
{
stack <- sys.calls()
stack <- stack[-(2:7)]
stack <- head(stack, -2)
stack <- sapply(stack, deparse)
if(!silent && isTRUE(getOption("show.error.messages")))
cat("This is the error stack: ", stack, sep="\n")
assign("stackmsg", value=paste(stack,collapse="\n"), envir=tryenv)
}), silent=silent)
if(inherits(out, "try-error")) out[2] <- tryenv$stackmsg
out
}
lower <- function(a) a+10
upper <- function(b) {plot(b, main=b) ; lower(b) }
d <- tryStack(upper(4))
d <- tryStack(upper("4"))
cat(d[2])
d <- tryStack(upper("4"))
This is the error stack:
tryStack(upper("4"))
upper("4")
lower(b)
Error in a + 10 : non-numeric argument to binary operator
I am a fan of evaluate::try_capture_stack().
x <- function() {
y()
}
y <- function() {
z()
}
z <- function() {
stop("asdf")
}
env <- environment()
e <- evaluate::try_capture_stack(quote(x()), env)
names(e)
#> [1] "message" "call" "calls"
e$calls
#> [[1]]
#> x()
#>
#> [[2]]
#> y()
#>
#> [[3]]
#> z()
#>
#> [[4]]
#> stop("asdf")
I'm a bit late to the party, but I found the best way was to use an exit handler in the function you are trying.
main <- function()
{
on.exit({
msg <- capture.output(traceback())
if (msg != "No traceback available ")
{
print(msg)
}
}
)
# rest of code
}
withCallingHandlers(
expr =
{
main()
},
error = function(e)
{
print(e)
}
)

Resources