I want to make informative stopifnot() errors.
I've read:
http://r-pkgs.had.co.nz/tests.html (the section at the end on using NSE to make informative test error print out for the example seems relevant)
and
http://adv-r.had.co.nz/Computing-on-the-language.html
but I cant get this to print an informative error in concise code:
e <- new.env()
e$label <- c(1,2,3)
check_in_y <- function(x, z, e) {
stopifnot(eval(bquote(.(x) %in% e[[.(z)]])))
}
check_in_y(5,"label", e)
The output gives this (not so informative)
Error: eval(bquote(.(x) %in% e[[.(z)]])) is not TRUE
I want the error to be more informative, saying this:
Error: 5 %in% e[["label"]] is not TRUE
How can I get this to work? Or what's the best approach to achieve what I want
I know I could write an if condition not true then print my own error as an alternative, but the extra code is a hassle. I'd like to understand how to get NSE to get this to work.
Edit:
My motivation from this approach came from reading hadley's comments (at http://r-pkgs.had.co.nz/tests.html):
However, if the expectation fails this doesn’t give very informative
output:
expect_floor_equal("year", "2008-01-01 00:00:00")
## Error: floor_date(base, unit) not equal to as.POSIXct(time, tz = "UTC")
## Mean absolute difference: 31622400
Instead you can use a little non-standard evaluation to produce
something more informative. The key is to use bquote() and eval(). In
the bquote() call below, note the use of .(x) - the contents of ()
will be inserted into the call.
expect_floor_equal <- function(unit, time) {
as_time <- function(x) as.POSIXct(x, tz = "UTC")
eval(bquote(expect_equal(floor_date(base, .(unit)), as_time(.(time)))))
}
expect_floor_equal("year", "2008-01-01 00:00:00")
## Error: floor_date(base, "year") not equal to as_time("2008-01-01 00:00:00")
stopifnot is just a convenience function for
if(!all(condition)) stop(standard message)
For custom messages, just write the code. You can replace the stopifnot call with two lines:
check_in_y <- function(x, z, e) {
b <- bquote(.(x) %in% e[[.(z)]])
if(!eval(b)) stop(deparse(b), " is not TRUE", call. = FALSE)
}
check_in_y(5, "label", e)
# Error: 5 %in% e[["label"]] is not TRUE
There are a number of packages on CRAN which address the issue of meaningful error messages. I have started with the assertthat and assertive packages but I'm now using checkmate for production code, especially for checking arguments to functions. BTW, checkmate also extends Hadley's testthat package.
With checkmate,
checkmate::assert_choice(5, e[["label"]])
as well as
checkmate::assert_choice(5, e$label)
return the error message:
Error: Assertion on '5' failed: Must be element of set {'1','2','3'}, but is '5'.
It can also be used in the function
check_in_y <- function(x, z, e) {
checkmate::assert_choice(x, e[[z]])
}
check_in_y(5, "label", e)
which returns the error message:
Error in check_in_y(5, "label", e) :
Assertion on 'x' failed: Must be element of set {'1','2','3'}, but is '5'.
Related
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 using R's assertthat package and am wanting to (temporarily) output a warning instead of an error on assertion failure. What's the easiest way to do that with the assertthat package?
I realize that wanting warnings instead of errors kind of goes against what assertions are supposed to be used for. In the long term, we indeed want to be outputting errors on assertion failure. In the short term, we still want the code to function even with bad input, since the output with bad inputs is still "good enough" for now.
A simple example: suppose I have a function that takes x as input and outputs x+5. I want to output a warning if x!=3. Since we will be using assert_that ultimately, it would be nice if we can use assertthat package for the warning.
In the long term, we'll use this:
> x <- 3
> fn <- function(x) {assert_that(x==3); return(x+5)}
> fn(3)
[1] 8
> fn(4)
Error: x not equal to 3
In the short term, here's the best I have so far:
> fn <- function(x) {if(!see_if(x==3)) warning(validate_that(x==3)); return(x+5)}
> fn(3)
[1] 8
> fn(4)
[1] 9
Warning message:
In fn(4) : x not equal to 3
I'm looking for a more concise solution, if possible (best case would be passing an "output_warning" parameter to assert_that, but I don't think that exists).
I created a user defined function which accepts a string corresponding to an expression against which you would like to run validate_that() (ultimately assert_that()). The function prints a warning if the assertion fails and remains silent otherwise. See below for usage. You could easily extend this custom function to accept more than one expression if necessary. Note that I also use sys.calls() to obtain the name of the function which called this helper function. This is an important piece of information so you can correlate your warnings with the code that actually generated them.
assert_that_soft <- function(exp) {
if (!exp) {
print (paste("Error in function:",
parse(sys.calls()[[sys.nframe()-1]])) ) # name of caller
}
}
Usage:
> fn <- function(x) { assert_that_soft(x==3); return(x+5) }
> fn(3)
[1] 8
> fn(8)
[1] "Error in function: fn(8)"
[1] 13
Another option is to wrap assert_that in tryCatch.
fn <- function(x) tryCatch(assert_that(x == 3), error = function(e) warning(e), finally = return(x+5))
fn(3)
# [1] 8
fn(8)
# [1] 13
# Warning message:
# x not equal to 3
I think the easiest way to overwrite the function would be to copy most of the assert_that function as is, and call the new function by the same name so you don't need to change all the code when you go into error mode.
assert_that <- function(..., env=parent.frame()) {
res <- see_if(..., env=env)
if (res)
return(TRUE)
warning(attr(res, "msg"))
TRUE
}
fn <- function(x) { assert_that(x==3); return(x+5) }
fn(3)
# [1] 8
fn(8)
# [1] 13
# Warning message:
# In assert_that(x == 3) : x not equal to 3
I am proposing an extension of the assertthat package to allow for simple warnings, see
https://github.com/hadley/assertthat/issues/69
any feedback is welcome!
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"
In an attempt to generate code that runs without warnings and hence can be run with options(warn=2), I am looking for an implementation of the suppressWarnings routine that would only filter warnings that match a given (vector of) regular expressions. Some warnings are just beyond my control, like the famous
Unrecognized record type 7, subtype 18 encountered in system file
when reading certain SPSS files, and I want to selectively suppress these without affecting possible other warnings.
Is there already an implementation of this functionality?
Suppress warnings with withCallingHandlers and invokeRestart, using the "muffleWarning" restart mentioned on ?warning
withCallingHandlers({
x <- 0
warning("Unrecognized record 123")
x <- x + 1
warning("another warning")
x + 1
}, warning = function(w) {
if (startsWith(conditionMessage(w), "Unrecognized record"))
invokeRestart("muffleWarning")
})
This has the output
[1] 2
Warning message:
In withCallingHandlers({ : another warning
(use tryCatch if instead you would like to stop on warning). As #BenBolker mentions this doesn't handle translations; making a more elaborate regex isn't going to be satisfactory. For catching one's own warnings, one could make and throw a subclass of warning.
I wrote a wrapper around #martin-morgan's answer for convenience, it works like SuppressWarnings except that you can pass a regular expression to the second argument (which will be passed to grepl) or a function that will be applied to the error message, using the dots as additional arguments.
I made it support the formula notation.
See examples below.
suppress_warnings <- function(.expr, .f, ...) {
eval.parent(substitute(
withCallingHandlers( .expr, warning = function(w) {
cm <- conditionMessage(w)
cond <-
if(is.character(.f)) grepl(.f, cm) else rlang::as_function(.f)(cm,...)
if (cond) {
invokeRestart("muffleWarning")
}
})
))
}
suppress_warnings({sqrt(-1); warning("ooops", call. = FALSE)}, startsWith, "o")
# Warning message:
# In sqrt(-1) : NaNs produced
suppress_warnings({sqrt(-1); warning("ooops", call. = FALSE)}, ~nchar(.)>10)
# Warning message:
# ooops
suppress_warnings({sqrt(-1); warning("ooops", call. = FALSE)}, "NaN")
# Warning message:
# ooops
I am using stopifnot and I understand it just returns the first value that was not TRUE. I f that is some freaky dynamic expression someone who is not into the custom function cannot really make something out of that. So I would love to add a custom error message. Any suggestions?
Error: length(unique(nchar(check))) == 1 is not TRUE
Basically states that the elements of the vector check do not have the same length.
Is there a way of saying: Error: Elements of your input vector do not have the same length!?
Use stop and an if statement:
if(length(unique(nchar(check))) != 1)
stop("Error: Elements of your input vector do not have the same length!")
Just remember that stopifnot has the convenience of stating the negative, so your condition in the if needs to be the negation of your stop condition.
This is what the error message looks like:
> check = c("x", "xx", "xxx")
> if(length(unique(nchar(check))) != 1)
+ stop("Error: Elements of your input vector do not have the same length!")
Error in eval(expr, envir, enclos) :
Error: Elements of your input vector do not have the same length!
A custom message can be added as a label to your expression:
stopifnot("Elements of your input vector do not have the same length!" =
length(unique(nchar(check))) == 1)
# Error: Elements of your input vector do not have the same length!
The assertive and assertthat packages have more readable check functions.
library(assertthat)
assert_that(length(unique(nchar(check))) == 1)
## Error: length(unique(nchar(check))) == 1 are not all true.
library(assertive)
assert_is_scalar(unique(nchar(check)))
## Error: unique(nchar(check)) does not have length one.
if(!is_scalar(unique(nchar(check))))
{
stop("Elements of check have different numbers of characters.")
}
## Error: Elements of check have different numbers of characters.
Or you could package it up.
assert <- function (expr, error) {
if (! expr) stop(error, call. = FALSE)
}
So you have:
> check = c("x", "xx", "xxx")
> assert(length(unique(nchar(check))) == 1, "Elements of your input vector do not have the same length!")
Error: Elements of your input vector do not have the same length!
What about embedding the stopifnot into tryCatch and then recasting the exception with stop using customized message?
Something like:
tryCatch(stopifnot(...,error=stop("Your customized error message"))
Unlike some other solutions this does not require additional packages. Compared to using if statement combined with stop you retain the performance advantages of stopifnot, when you use new R versions. Since R version 3.5.0 stopifnot evaluates expressions sequentially and stops on first failure.
I would recommend you check out Hadley's testthat package. It allows for intuitive testing: the names of the functions are great and the way you write them is like a sentence -- "I expect that length(unique(nchar(check))) is [exactly|approximately] 1". The errors produced are informative.
See here:
http://journal.r-project.org/archive/2011-1/RJournal_2011-1_Wickham.pdf
In your case,
> library(testthat)
> check = c("x", "xx", "xxx")
> expect_that(length(unique(nchar(check))), equals(1))
Error: length(unique(nchar(check))) not equal to 1
Mean relative difference: 2
Also note that you don't have the problem that #Andrie referenced with sometimes having to think about double negatives with stopifnot. I know it seems simple, but it caused me many headaches!
The answers already provided are quite good, and mine is just an addition to that collection. For some people it could be more convenient to use one-liner in form of the following function:
stopifnotinform <- function(..., message = "err") {
args <- list(...)
if (length(args) == 0) {
return(NULL)
}
for (i in 1:length(args)) {
result <- args[[i]]
if (is.atomic(result) && result == FALSE) {
stop(message)
}
}
}
# throws an error
stopifnotinform(is.integer(1L), is.integer(2), message = "Some number(s) provided is not an integer")
# continues with execution
stopifnotinform(is.integer(1L), is.integer(2L), message = "Some number(s) provided is not an integer")
Bear in mind that this solution provides you with only one (common) error message for all parameters in ....
Try this:
same_length <- FALSE
stopifnot("Elements of your input vector do not have the same length!" = same_length)
#> Error : Elements of your input vector do not have the same length!