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
Related
I have kind of a strange case where I'm trying to look for a specific warning and return one thing if I see it and a different thing if I don't. I feel like I must be missing something, but I can't figure out how to do it, at least not without calling the originating function twice. Thanks in advance for any pointers.
The specific case is: I'm reading in files with data.table::fread() and, if I see a specific parsing warning, I want to return NULL instead of the (incorrectly) parsed data.
Below are my first three attempts, and some tests to prove the issue with them. Note that my_func3 actually passes all the tests, but requires reading in all the data twice. Obviously, in my real application, the data is much larger and hence this is definitely not ideal.
# this one fails test 3
# because it doesn't return anything if _any_ warning is caught
my_func1 <- function(.string) {
res <- tryCatch(
{
data.table::fread(text = .string)
},
warning = function(.w) {
if (grepl("Stopped early.+TABLE NO", .w$message)) {
warning("my custom warning")
return(NULL)
} else {
warning(.w)
}
}
)
}
# this one fails test 2
# because it returns the parsed df even if we catch the custom warning
my_func2 <- function(.string) {
res <- withCallingHandlers(
{
data.table::fread(text = .string)
},
warning = function(.w) {
if (grepl("Stopped early.+TABLE NO", .w$message)) {
warning("my custom warning")
return(NULL)
} else {
warning(.w)
}
}
)
}
# this one passes all three
# but it requires reading the data twice
my_func3 <- function(.string) {
res <- tryCatch(
{
data.table::fread(text = .string)
},
warning = function(.w) {
if (grepl("Stopped early.+TABLE NO", .w$message)) {
warning("my custom warning")
return(NULL)
} else {
data.table::fread(text = .string)
}
}
)
}
##################
# TESTS
##################
# uncomment the one you want to test
#my_func <- my_func1
#my_func <- my_func2
#my_func <- my_func3
library(testthat)
test_that("test 1: my_func returns df when no warning", {
df <- my_func("a,b\n1,2\n3,4")
expect_equal(nrow(df), 2)
expect_equal(ncol(df), 2)
})
test_that("test 2: my_func warns and returns NULL on custom warning", {
expect_warning(
df <- my_func("a,b\n1,2\nTABLE NO\n3,4"),
regexp = "my custom warning"
)
expect_null(df)
})
test_that("test 3: my_func warns and returns df on other warning ", {
expect_warning(
df <- my_func("a,b\n1,2,3\n")
)
expect_equal(nrow(df), 1)
expect_equal(ncol(df), 3)
})
Any thoughts on how to accomplish this without having to read the data twice are very much appreciated.
Ok, I got an answer from a colleague. It is below, using the much simpler warning_prone_function() example courtesy of #allan-cameron.
The key here is to pass our custom warning back up to the enclosing environment with <<- and then check it before we return from my_func. Then we raise any other warning we may have gotten, and continue through with invokeRestart("muffleWarning"). (The muffleWarning parts prevent it from raising the same warning again when we restart. I'm pretty sure this doesn't cause warning_prone_function() to get called again, but to be honest, the invokeRestart docs baffle me a little bit, so I may be wrong. Either way, see note below about a way to do this without invokeRestart, if necessary.
Hope this is helpful for someone. Thanks for #allan-cameron.
warning_prone_function <- function(.string) {
num <- as.numeric(.string)
num <- num[!is.na(num)]
cor(seq_along(num), num)
}
my_func <- function(.string) {
W <- NULL
res <- withCallingHandlers(
{
warning_prone_function(.string)
},
warning = function(.w) {
if (grepl("coercion", .w$message)) {
W <<- "Some strings were not numbers"
} else {
warning(.w)
}
invokeRestart("muffleWarning")
}
)
if (!is.null(W)) {
warning(W)
res <- NULL
}
return(res)
}
###############
# TESTS
###############
library(testthat)
test_that("test 1: my_func returns df when no warning", {
res <- my_func(c("1", "2", "3"))
expect_equal(res, 1)
})
test_that("test 2: my_func warns and returns NULL on custom warning", {
expect_warning(
res <- my_func(c("a", "b", "c")),
regexp = "Some strings were not numbers"
)
expect_null(res)
})
test_that("test 3: my_func warns and returns res on other warning ", {
expect_warning(
res <- my_func(c("1", "1", "1")),
"standard deviation"
)
expect_true(is.na(res))
})
NOTE: technically, the tests pass if you remove the else block and the invokeRestart section:
else {
warning(.w)
}
invokeRestart("muffleWarning")
However, removing these causes the original "coercion" warning and your custom warning to both be raised. Using it as written above suppresses the "coercion" warning, which was my original intent (though not stated in the OP).
Unfortunately, fread doesn't lend itself well to a reproducible example, so let's create another warning-prone function:
warning_prone_function <- function(.string)
{
num <- as.numeric(.string)
num <- num[!is.na(num)]
cor(seq_along(num), num)
}
This function will easily produce 2 different warnings: one if NAs are produced in coercion from strings to numbers, and a different one if all strings are the same number.
# Input OK - no warning
warning_prone_function(c("1", "2", "3"))
#> [1] 1
# Input produces standard deviation warning
warning_prone_function(c("1", "1", "1"))
#> Warning in cor(seq_along(num), num): the standard deviation is zero
#> [1] NA
# Input produces coercion warning
warning_prone_function(c("a", "b", "c"))
#> Warning in warning_prone_function(c("a", "b", "c")): NAs introduced by coercion
#> [1] NA
Now let's wrap our function in a warning handler that gives a custom warning and returns NULL if there is coercion, but in other cases behaves the same as warning_prone_function
my_func <- function(.string) {
res <- tryCatch(
{
warning_prone_function(.string)
},
warning = function(.w) {
if (grepl("coercion", .w$message)) {
warning("Some strings were not numbers")
return(NULL)
} else {
warning_prone_function(.string)
}
}
)
res
}
So, testing the same inputs, we get:
my_func(c("1", "2", "3"))
#> [1] 1
my_func(c("1", "1", "1"))
#> Warning in cor(seq_along(num), num): the standard deviation is zero
#> [1] NA
my_func(c("a", "b", "c"))
#> Warning in value[[3L]](cond): Some strings were not numbers
#> NULL
Created on 2021-11-15 by the reprex package (v2.0.0)
I want to catch a warning and still run an expression.
Here is an example:
x <- 0
tryCatch({
x <- as.numeric("text") # this is NA and causes warning
}, warning = function(w) {
print("I am a message")
})
x
# x still 0
Previous code catches the warning and print the message, BUT the value of x is not NA afterwards, which means that the expression did not run because of the warning.
I could run the expression with suppressWarnings() and <<- as follows:
x <- 0
tryCatch({
x <- as.numeric("text")
}, warning = function(w) {
print("I am a message")
suppressWarnings(x <<- as.numeric("text"))
})
x
# now x is NA
Is there a more elegant way to do that? maybe one of following examples?
another function other than tryCatch()
or using some parameter of tryCatch()
or maybe another package other than base
...
From this answer follows that this code could work:
x <- 0
withCallingHandlers({
x <- as.numeric("text")
}, warning = function(w) {
print("I am a message")
invokeRestart("muffleWarning")
})
x
(I came across this post looking for a way to catch a warning and alter the return value of a function. I ended up with
which_nondefault_enc <- function(txt) {
ans <- rep(NA, length(txt))
for (i in seq(1, length(txt)))
ans[i] <- tryCatch(stringi::stri_enc_tonative(txt[i]), warning = function(w) return(NA))
return(which(is.na(ans)))
}
which returns those indices of the vector, where warnings like "unable to translate '<U+0001F41F>' to native encoding" are used as a selection criterion.)
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
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
}
)
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)