Here is my code:
test <- function(y){
irisname <- c("Sepal.Length","Sepal.Width","Petal.Length","Petal.Width","Species")
if(y %in% irisname){
print(y)
} else{
test <- function(...) stop("dummy error")
test(y)
}
}
> test("ds")
Error in test(y) : dummy error
In the result: "Error in test(y) : dummy error ", I need "ds" in test("ds"), not test(y).
How can I do that?
This almost does it (there's an extra colon ...), by using call.=FALSE to suppress the information about the call and hacking it into the error message.
update: added quotation marks to error #1; explained a bit more about why this problem is hard.
I don't know the structure of your code, but you are making life considerably harder for yourself by passing objects farther down into the structure. It would be a lot easier to call stop() directly from within your first level, or to use the information carried in y directly within your error message.
test <- function(y,stop=FALSE){
irisname <- c("Sepal.Length","Sepal.Width",
"Petal.Length","Petal.Width","Species")
if (stop) stop(sprintf("premature stop: var %s",y))
if(y %in% irisname){
print(y)
} else{
test <- function(...) {
stop(sprintf("in test(\"%s\"): dummy error",...),
call.=FALSE)
}
test(y)
}
}
test("junk")
## Error: in test("junk"): dummy error
test("junk",stop=TRUE)
## Error in test("junk", stop = TRUE) : premature stop: var junk
Getting rid of the spurious first colon in the output of test("junk") will be considerably harder, because the Error: string is hard-coded within R. Your best bet is probably, somehow, to print your own custom error message and then stop silently, or recreate the behaviour of stop() without generating the message (see ?condition: e.g. return(invisible(simpleError("foo")))). However, you're going to have to jump through a lot of hoops to do this, and it will be hard to ensure that you get exactly the same behaviour that you would have with stop() (e.g. will the error message have been saved in the error-message buffer?)
What you want to do is probably possible by mucking around with R internals enough, but in my opinion so hard that it would be better to rethink the problem ...
Good luck.
You could check the argument right at the start of the function. match.arg might come in handy, or you could print custom message and return NA.
two updates below
> test <- function(y)
{
if(!(y %in% names(iris))){
message(sprintf('test("%s") is an error. "%s" not found in string', y, y))
return(NA) ## stop all executions and exit the function
}
return(y) ## ... continue
}
> test("Sepal.Length")
# [1] "Sepal.Length"
> test("ds")
# test("ds") is an error. "ds" not found in string
# [1] NA
Add/Edit : Is there a reason why you're nesting a function when the function goes to else? I removed it, and now get the following. It seems all you are doing is checking an argument, and end-users (and RAM) want to know immediately if they enter an incorrect default arguments. Otherwise, you're calling up unnecessary jobs and using memory when you don't need to.
test <- function(y){
irisname <- c("Sepal.Length","Sepal.Width","Petal.Length","Petal.Width","Species")
if(y %in% irisname){
print(y)
} else{
stop("dummy error")
}
}
> test("ds")
# Error in test("ds") : dummy error
> test("Sepal.Length")
# [1] "Sepal.Length"
You could also use pmatch, rather than match.arg, since match.arg prints a default error.
> test2 <- function(x)
{
y <- pmatch(x, names(iris))
if(is.na(y)) stop('dummy error')
names(iris)[y]
}
> test2("ds")
# Error in test2("ds") : dummy error
> test2("Sepal.Length")
# [1] "Sepal.Length"
Related
I have a function that may throw an error. When an error is thrown, I'd like to show the error message, as if the error actually occurred, and further return an object invisibly.
I looked at this thread, which uses withCallingHandlers and logs the error message somewhere. This comes close, but I do not want to log the message as text and then print a text message, the function should show the error message as if it would have exited on error.
The functions workflow looks like the following:
foo <- function(x){
y <- x + 1
if(y == 2) {
stop("oops")
# also return y invisibly when error is thrown,
}
z <- y + 1
z
}
Based on input x an intermediate y is calculated. y is used for the error check. If an error occurs y should be returned invisibly and an normal error message should be thrown. Otherwise z is calculated an returned.
foo(1) should return error message and y invisibly.
I thought about using on.exit but in this case, always y is return invisibly.
Any help is appreciated.
Add: Maybe what I have in mind is not possible. In this case, would it be possible to show a logged error message in a way that comes close to a real error message?
Add2: I thought about issuing a warning, but in my actual use case a warning would be misleading, since the function does not produce desired result z, but just some intermediate result y and I want to return y so that the user can inspect it further, and reason about why it wasn't processed correctly by foo. Thinking about it, other must have encountered the same problem, there should be some kind of solution.
Add3: Maybe it is possible to use on.exit together with a flag which is triggered, so that on.exit will return y invisibly in case of an error and do nothing otherwise.
func <- function(x) { a <- simpleError("quux"); attr(a,"abc") <- 7; stop(a); }
func()
# Error: quux
So far so good, we see an error. If we catch this and look at the contents of the error message we can see the attribute tucked inside:
dput(tryCatch(func(), error=function(e) e))
# structure(list(message = "quux", call = NULL), class = c("simpleError",
# "error", "condition"), abc = 7)
and even extract it easily
dput(tryCatch(func(), error=function(e) attr(e,"abc")))
# 7
Below I post my final solution to my question. Basically it is based on r2evans answer combined with user20650's comment.
As r2evans showed we can use simpleError to create an error and also attach an object in the attributes. The big plus of this approach is that it returns a real error that we can program with. If we would only show the error message and then return a vector invisibly, tryCatch wouldn't recognize it as an error. The downside is that simpleError doesn't look like a normal error to an interactive user when printed in the console. It will show something like <simpleError: x must not be 1>. However, the message is not printed in red like normal errors.
Here user20650's comment shows a nice way out. We can first print the message with message(conditionMessage(e)) and then we can return the simpleError invisibly.
foo <- function(x) {
y <- x + 1
if(y == 2) {
foo_internal <- function(val) {
a <- simpleError("x must not be 1")
attr(a,".data") <- y
stop(a)
}
return(
tryCatch(foo_internal(y),
error = function(e) {
message(conditionMessage(e))
invisible(e)
})
)
}
z <- y + 1
z
}
# this is a special function to inspect the object attached to `simpleError`
inspect <- function(x = NULL) {
if(is.null(x)) {
x <- .Last.value
}
attr(x,".data")
}
# returns error message
foo(1)
#> x must not be 1
# we can get y's value with a special inspect function
inspect()
#> [1] 2
# foo(1) returns a "real" error
class(foo(1))
#> x must not be 1
#> [1] "simpleError" "error" "condition"
Created on 2021-03-13 by the reprex package (v0.3.0)
I want to reattempt failing readLines fetches using tryCatch. This works as expected, as long as I don't wrap it inside a future.apply::future_lapply call for processing a list or vector.
The problem can be reproduced using this code:
read_lines_retrying <- function(url, attempts = 5, throttle = 5) {
result <- NA
while (is.na(result) && 0 < attempts) {
attempts <- attempts - 1
result <- tryCatch(
{
readLines(url)
},
error = function(cond) {
message("caught error:")
message(cond)
message("")
Sys.sleep(throttle)
return(NA)
}
)
}
if (is.na(result)) {
stop(paste("could not get URL ", url))
}
return(result)
}
urls <- c("http://nonexistant.nonexistant")
future.apply::future_lapply(urls, read_lines_retrying)
Of course, the code is meant to retry on transient readLines failures, while the example URL will always fail, but this way problem can be most easily seen. When using lapply instead of future.apply::future_lapply, it takes at least 5 seconds to complete because it waits 5 seconds after each of the 5 attempts. This in not the case with future.apply::future_lapply, demonstrating that the exception handling doesn't work.
What am I doing wrong, and how can I get tryCatch to work inside future.apply::future_lapply?
Author of futureverse here: This is an interesting problem.
Here's a minimal reproducible example:
boom <- function(x) {
tryCatch(stop("boom"), error = function(cond) {
message(1); message(cond); message(2)
})
}
y <- lapply(1L, FUN = boom)
## 1
## boom2
y <- future.apply::future_lapply(1L, FUN = boom)
## 1
## Error in doTryCatch(return(expr), name, parentenv, handler) : boom
We can even reproduce this with individual futures:
> y <- boom(1)
## 1
## boom2
> f <- future::future(boom(1))
> y <- future::value(f)
## 1
## Error in doTryCatch(return(expr), name, parentenv, handler) ## : boom
First of all, it turns out that it message(cond) that trigger this odd behavior. If you instead, for instance, use message(conditionMessage(cond)), it works fine.
UPDATE 2022-03-01: After asking about this on R-devel (thread 'message() and warning() circumvent calling handlers and signal the original class, e.g. an error' on 2022-03-01 (https://stat.ethz.ch/pipermail/r-devel/2022-March/081515.html)), I conclude that using message(e) where e is an error condition is incorrect and that one should use message(conditionMessage(e)).
Technical details below:
What happens is that message(cond) end up re-signalling the caught error (= cond). And, despite message() is muffling the error signal internally, it turns out that the future still detects it and takes it as a definite error.
I have a hunch what might be happening, but I cannot promise a quick solution. I'm now tracking this in https://github.com/HenrikBengtsson/future/issues/507. Until resolved, the workaround is: "avoid resignaling the error you just caught", i.e. don't call message(cond) or warning(cond) on an error condition.
Thanks a bunch for reporting this important issue.
PS. Please consider https://github.com/HenrikBengtsson/future/discussions for future discussions, because I'm only skimming StackOverflow occasionally.
I have a regression model (lm or glm or lmer ...) and I do fitmodel <- lm(inputs) where inputs changes inside a loop (the formula and the data). Then, if the model function does not produce any warning I want to keep fitmodel, but if I get a warning I want to update the model and I want the warning not printed, so I do fitmodel <- lm(inputs) inside tryCatch. So, if it produces a warning, inside warning = function(w){f(fitmodel)}, f(fitmodel) would be something like
fitmodel <- update(fitmodel, something suitable to do on the model)
In fact, this assignation would be inside an if-else structure in such a way that depending on the warning if(w$message satisfies something) I would adapt the suitable to do on the model inside update.
The problem is that I get Error in ... object 'fitmodel' not found. If I use withCallingHandlers with invokeRestarts, it just finishes the computation of the model with the warning without update it. If I add again fitmodel <- lm(inputs) inside something suitable to do on the model, I get the warning printed; now I think I could try suppresswarnings(fitmodel <- lm(inputs)), but yet I think it is not an elegant solution, since I have to add 2 times the line fitmodel <- lm(inputs), making 2 times all the computation (inside expr and inside warning).
Summarising, what I would like but fails is:
tryCatch(expr = {fitmodel <- lm(inputs)},
warning = function(w) {if (w$message satisfies something) {
fitmodel <- update(fitmodel, something suitable to do on the model)
} else if (w$message satisfies something2){
fitmodel <- update(fitmodel, something2 suitable to do on the model)
}
}
)
What can I do?
The loop part of the question is because I thought it like follows (maybe is another question, but for the moment I leave it here): it can happen that after the update I get another warning, so I would do something like while(get a warning on update){update}; in some way, this update inside warning should be understood also as expr. Is something like this possible?
Thank you very much!
Generic version of the question with minimal example:
Let's say I have a tryCatch(expr = {result <- operations}, warning = function(w){f(...)} and if I get a warning in expr (produced in fact in operations) I want to do something with result, so I would do warning = function(w){f(result)}, but then I get Error in ... object 'result' not found.
A minimal example:
y <- "a"
tryCatch(expr = {x <- as.numeric(y)},
warning = function(w) {print(x)})
Error in ... object 'x' not found
I tried using withCallingHandlers instead of tryCatch without success, and also using invokeRestart but it does the expression part, not what I want to do when I get a warning.
Could you help me?
Thank you!
The problem, fundamentally, is that the handler is called before the assignment happens. And even if that weren’t the case, the handler runs in a different scope than the tryCatch expression, so the handler can’t access the names in the other scope.
We need to separate the handling from the value transformation.
For errors (but not warnings), base R provides the function try, which wraps tryCatch to achieve this effect. However, using try is discouraged, because its return type is unsound.1 As mentioned in the answer by ekoam, ‘purrr’ provides soundly typed functional wrappers (e.g. safely) to achieve a similar effect.
However, we can also build our own, which might be a better fit in this situation:
with_warning = function (expr) {
self = environment()
warning = NULL
result = withCallingHandlers(expr, warning = function (w) {
self$warning = w
tryInvokeRestart('muffleWarning')
})
list(result = result, warning = warning)
}
This gives us a wrapper that distinguishes between the result value and a warning. We can now use it to implement your requirement:
fitmodel = with(with_warning(lm(inputs)), {
if (! is.null(warning)) {
if (conditionMessage(warning) satisfies something) {
update(result, something suitable to do on the model)
} else {
update(result, something2 suitable to do on the model)
}
} else {
result
}
})
1 What this means is that try’s return type doesn’t distinguish between an error and a non-error value of type try-error. This is a real situation that can occur, for example, when nesting multiple try calls.
It seems that you are looking for a functional wrapper that captures both the returned value and side effects of a function call. I think purrr::quietly is a perfect candidate for this kind of task. Consider something like this
quietly <- purrr::quietly
foo <- function(x) {
if (x < 3)
warning(x, " is less than 3")
if (x < 4)
warning(x, " is less than 4")
x
}
update_foo <- function(x, y) {
x <- x + y
foo(x)
}
keep_doing <- function(inputs) {
out <- quietly(foo)(inputs)
repeat {
if (length(out$warnings) < 1L)
return(out$result)
cat(paste0(out$warnings, collapse = ", "), "\n")
# This is for you to see the process. You can delete this line.
if (grepl("less than 3", out$warnings[[1L]])) {
out <- quietly(update_foo)(out$result, 1.5)
} else if (grepl("less than 4", out$warnings[[1L]])) {
out <- quietly(update_foo)(out$result, 1)
}
}
}
Output
> keep_doing(1)
1 is less than 3, 1 is less than 4
2.5 is less than 3, 2.5 is less than 4
[1] 4
> keep_doing(3)
3 is less than 4
[1] 4
Are you looking for something like the following? If it is run with y <- "123", the "OK" message will be printed.
y <- "a"
#y <- "123"
x <- tryCatch(as.numeric(y),
warning = function(w) w
)
if(inherits(x, "warning")){
message(x$message)
} else{
message(paste("OK:", x))
}
It's easier to test several argument values with the code above rewritten as a function.
testWarning <- function(x){
out <- tryCatch(as.numeric(x),
warning = function(w) w
)
if(inherits(out, "warning")){
message(out$message)
} else{
message(paste("OK:", out))
}
invisible(out)
}
testWarning("a")
#NAs introduced by coercion
testWarning("123")
#OK: 123
Maybe you could assign x again in the handling condition?
tryCatch(
warning = function(cnd) {
x <- suppressWarnings(as.numeric(y))
print(x)},
expr = {x <- as.numeric(y)}
)
#> [1] NA
Perhaps not the most elegant answer, but solves your toy example.
Don't put the assignment in the tryCatch call, put it outside. For example,
y <- "a"
x <- tryCatch(expr = {as.numeric(y)},
warning = function(w) {y})
This assigns y to x, but you could put anything in the warning body, and the result will be assigned to x.
Your "what I would like" example is more complicated, because you want access to the expr value, but it hasn't been assigned anywhere at the time the warning is generated. I think you'll have to recalculate it:
fitmodel <- tryCatch(expr = {lm(inputs)},
warning = function(w) {if (w$message satisfies something) {
update(lm(inputs), something suitable to do on the model)
} else if (w$message satisfies something2){
update(lm(inputs), something2 suitable to do on the model)
}
}
)
Edited to add:
To allow the evaluation to proceed to completion before processing the warning, you can't use tryCatch. The evaluate package has a function (also called evaluate) that can do this. For example,
y <- "a"
res <- evaluate::evaluate(quote(x <- as.numeric(y)))
for (i in seq_along(res)) {
if (inherits(res[[i]], "warning") &&
conditionMessage(res[[i]]) == gettext("NAs introduced by coercion",
domain = "R"))
x <- y
}
Some notes: the res list will contain lots of different things, including messages, warnings, errors, etc. My code only looks at the warnings. I used conditionMessage to extract the warning message, but
it will be translated to the local language, so you should use gettext to translate the English version of the message for comparison.
I'm working on an R package and I need some help writing R test functions that are meant to check whether the correct warning is being thrown on C-side code and then caught on the R side. Let me give you some background on what I'm working on exactly:
Most of what I'm writing is done on the C side. In addition, I have an if-statement type macro in C that allows the coder to pass a warning to R in the form of a string. The basic premise is that if(statement_true) pass_warning_to_R("Warning string to pass"). What I'd like to do is test whether these warnings are being thrown when I expect/need them to be by writing an R file that uses tryCatch blocks.
So far I've written something similar to this:
counter <- 0
tryCatch({
function_im_testing()
}, warning = function(war) {
# Check if warning is as expected and if so increment counter
if(toString(war)=="The warning I'm expecting/testing for"){
print(toString(war))
counter <- counter + 1
}
}, error = function(err) {
print(toString(err))
}, finally = {
print("Leaving tryCatch")
})
# Stop if the 3 warnings we expected aren't present
stopifnot(counter == 3)
This is the method I'm using and, so far, I haven't even been able to get the if statement to execute by trying to get toString(war) and "Warning I'm expecting/testing for" to be the same thing. This, in addition with the fact that this method is pretty sloppy and unreliable, leads me to believe that there's a better way. So, is there a better approach to doing this?
Usually with warnings you'd like to allow evaluation to continue; tryCatch is used to stop evaluation. So instead use withCallingHandlers with a handler for warnings that does what you want, and then invokes the 'muffleWarning' restart. The message of an error / warning can be extracted with conditionMessage
counter <- 0L
withCallingHandlers({
function_im_testing()
}, warning = function(w) {
if (conditionMessage(w) == "The warning I'm expecting/testing for")
counter <<- counter + 1L
invokeRestart("muffleWarning")
})
Since you're writing your own package, it makes sense to create warnings that can be identified in a more robust way, e.g., the following returns a condition that can be used in warning, but that has a class 'bad_input' that can be used in withCallingHandlers.
bad_input <- function(...) {
w <- simpleWarning(...)
class(w) <- c("bad_input", class(w))
w
}
To be used like warning(bad_input("your input is bad")) and producing output with
fun <- function() {
warning("oops")
warning(bad_input("your input is bad"))
"DONE"
}
like
> fun()
[1] "DONE"
Warning messages:
1: In fun() : oops
2: your input is bad
> counter <- 0L
> withCallingHandlers(fun(), bad_input = function(w) {
+ counter <<- counter + 1L
+ invokeRestart("muffleWarning")
+ })
[1] "DONE"
Warning message:
In fun() : oops
> counter
[1] 1
Apart from actually capturing the warning, you need to be aware that warning messages are translated:
library(devtools)
with_envvar(c(LANG = "en"), log(-1))
# In log(-1) : NaNs produced
with_envvar(c(LANG = "de"), log(-1))
# In log(-1) : NaNs wurden erzeugt
with_envvar(c(LANG = "fr"), log(-1))
# In log(-1) : production de NaN
with_envvar(c(LANG = "ko"), log(-1))
# In log(-1) : NaN이 생성되었습니다
So if you're doing this inside a test, make sure you set the LANG environmental variable to ensure that the message doesn't vary according to what computer it's run on.
Check out testthat::expect_warnings()
Code written using lapply and friends is usually easier on the eyes and more Rish than loops. I love lapply just as much as the next guy, but how do I debug it when things go wrong? For example:
> ## a list composed of numeric elements
> x <- as.list(-2:2)
> ## turn one of the elements into characters
> x[[2]] <- "what?!?"
>
> ## using sapply
> sapply(x, function(x) 1/x)
Error in 1/x : non-numeric argument to binary operator
Had I used a for loop:
> y <- rep(NA, length(x))
> for (i in 1:length(x)) {
+ y[i] <- 1/x[[i]]
+ }
Error in 1/x[[i]] : non-numeric argument to binary operator
But I would know where the error happened:
> i
[1] 2
What should I do when using lapply/sapply?
Use the standard R debugging techniques to stop exactly when the error occurs:
options(error = browser)
or
options(error = recover)
When done, revert to standard behaviour:
options(error = NULL)
If you wrap your inner function with a try() statement, you get more information:
> sapply(x, function(x) try(1/x))
Error in 1/x : non-numeric argument to binary operator
[1] "-0.5"
[2] "Error in 1/x : non-numeric argument to binary operator\n"
[3] "Inf"
[4] "1"
[5] "0.5"
In this case, you can see which index fails.
Use the plyr package, with .inform = TRUE:
library(plyr)
laply(x, function(x) 1/x, .inform = TRUE)
Like geoffjentry said:
> sapply(x, function(x) {
res <- tryCatch(1 / x,
error=function(e) {
cat("Failed on x = ", x, "\n", sep="") ## browser()
stop(e)
})
})
Also, your for loop could be rewritten to be much cleaner (possibly a little slower):
> y <- NULL
> for (xi in x)
y <- c(y, 1 / xi)
Error in 1/xi : non-numeric argument to binary operator
For loops are slow in R, but unless you really need the speed I'd go with a simple iterative approach over a confusing list comprehension.
If I need to figure out some code on the fly, I'll always go:
sapply(x, function(x) {
browser()
...
})
And write the code from inside the function so I see what I'm getting.
-- Dan
Using debug or browser isn't a good idea in this case, because it will stop your code so frequently. Use Try or TryCatch instead, and deal with the situation when it arises.
You can debug() the function, or put a browser() inside the body. This is only particularly useful if you don't have a gajillion iterations to work through.
Also, I've not personally done this, but I suspect you could put a browser() in as part of a tryCatch(), such that when the error is generated you can use the browser() interface.
I've faced the same problem and have tended to make my calls with (l)(m)(s)(t)apply to be functions that I can debug().
So, instead of blah<-sapply(x,function(x){ x+1 })
I'd say,
myfn<-function(x){x+1}
blah<-sapply(x,function(x){myfn(x)})
and use debug(myfn) with options(error=recover).
I also like the advice about sticking print() lines here and there to see what is happening.
Even better is to design a test of myfn(x) that it has to pass and to be sure it passes said test before subjecting it to sapply. I only have patience to to this about half the time.