When I type warnings() to console, I get back
Warning message:
In fread(my_directory, ... :
C function strtod() returned ERANGE for one or more fields. The first was string input '4.40589099726375E-309'. It was read using (double)strtold() as numeric
However when I type as.character(warnings()), I get:
[1] "fread(my_directory)"
My objective is to get the actual message displayed in warning() into a character string, so that I can pass it to the logwarn function in the logging package. Currently, I am doing logwarn(warnings(),logger="some_log_file.log") to record my warnings, but it gives the incorrect coercion to character that I displayed above.
Note that I can just use sink but I want to stick with logging package, so I require the ability to correct coerce to character.
This may not be the exact answer you're looking for, but I think it's worth a mention.
R has a global variable, last.warning, which holds just that, the last warning. Calling names on it will return the last warning as a character string. Here's a little example
First, purposely trigger a warning:
x <- 1:5
if(x == 1) "yes" else "no"
# [1] "yes"
# Warning message:
# In if (x == 1) "yes" else "no" :
# the condition has length > 1 and only the first element will be used
Look at the variable last.warning:
last.warning
# $`the condition has length > 1 and only the first element will be used`
# if (x == 1) "yes" else "no"
Now look at the names(last.warning). This returns the warning as a character string:
names(last.warning)
# [1] "the condition has length > 1 and only the first element will be used"
warnings() returns a list.
The list values are the language elements which produced the warning; that is what you are seeing with as.character().
The names of the list values are the warning messages. You can get those with names(warnings()).
Use a calling handler along with the 'restart' (see ?warning and ?withCallingHandlers) that warning() creates
f = function() { warning("oops"); 1 }
withCallingHandlers({
f()
}, warning=function(cond) {
txt <- conditionMessage(cond)
## do with txt what you will, e.g.,
## logwarn(txt, logger="some_log_file.log")
message("captured warning: ", txt, "; now continuing")
## signal that the warning has been handled
invokeRestart("muffleWarning")
})
Related
I would like to assert some expressions involving certain variable that is potentially evaluated to character(). I would like to print an assertation message showing the value of the variable which can be character().
assertthat::assert_that(<expr containing variable [x]>, msg = sprintf("Test for x failed on value %s" , x))
## Variable [x] is a character variable that can be character() or other conventional characters like `"a"`, `"b"` or ``"c"``.
Below is a simplified example to show the error I obtained when the variable is evaluated to character():
assertthat::assert_that(FALSE, msg = sprintf("%s", character()))
gives me error
## > Error in stop(assertError(attr(res, "msg"))) : bad error message
However the sprintf itself works well
sprintf("%s", character())
## character(0)
sprintf("%s", character()) %>% typeof
## [1] "character"
What I have tried:
Wrap %s with backticks assert_that(FALSE, msg = sprintf("`%s`", character()))
Load the assertthat package first with library(assertthat) then call assert_that(...)
Assign first character() to a variable and call that variable in assert_that which is actually more similar to my real life use case
v <- character()
assert_that(FALSE, msg = sprintf("`%s`", v))
Assign the return value of sprintf call to a variable and then feed it into the call of assert_that
v <- character()
errmsg <- sprintf("`%s`", v)
assert_that(FALSE, msg = errmsg)
All gave same error. It seems something inside assert_that affects.
What would be the reason of the error and how to fix it?
I think the problem here is that your sprintf statements results in a character with length 0:
length(sprintf("%s", character()))
#> [1] 0
This means there is not really a message for assert_that to print. So you have to ensure the length of the sprintf output has a length of 1:
require(assertthat)
#> Loading required package: assertthat
assert_that(F, msg=character())
#> Error in stop(assertError(attr(res, "msg"))) : bad error message
assert_that(F, msg=letters[1:2])
#> Error in stop(assertError(attr(res, "msg"))) : bad error message
assert_that(F, msg=letters[1])
#> Error: a
I'm running a complicated function (multiple imputation with Amelia) over a list of datasets. Every so often, a dataset will trigger a long list of warnings that eventually result in an error. I would like R to give up as soon as the first warning is issued and move on to the next dataset. Here is a minimal working example:
df.list <- list(
data.frame(1:4),
data.frame(-1, -2, -4),
data.frame(10:15)
)
for(df in df.list){
ans <- sum(sapply(df, sqrt))
print(ans)
}
The script issues three warnings about NaNs and then prints:
[1] 6.146264
[1] NaN
[1] 21.1632
I would like it to produce 1 message input 2 failed and then output only the valid results:
[1] 6.146264
[1] 21.1632
(The function I'm actually running, amelia(), issues warnings for 10 minutes before finally throwing an error, so I would like to cut it off at the first warning.)
What about this: the sqrt function cannot return -1 so I make tryCatch return -1 when a warning occurs. The nested lapply is required to loop through the list elements to calculate the square root, returned as a list, and then to loop through those list elements to sum. The -1 value in the result indicates a failed calculation and I can test that.
result <- unlist(
lapply(
lapply(df.list, function(x) tryCatch(sqrt(x), warning = function(w) -1)), sum))
failed <- which(result == -1)
result <- result[-failed]
print(paste0("input ", failed, " failed"))
result
> print(paste0("input ", failed, " failed"))
[1] "input 2 failed"
> result
[1] 6.146264 21.163196
What I'm trying to achieve
I'm trying to write my own 'impute' function in R with a tryCatch statement which:
1. outputs a warning/error message containing the function name so I can debug easier.
2. Raises a warning if the function runs ok but doesn't impute all the missing values.
ImputeVariables <- function(impute.var, impute.values,
filter.var){
# function to impute values.
# impute.var = variables with NAs
# impute.values = the missing value(s) to replace NAs, value labesl are levels
# filter.var = the variables to filter on.
# filter.levels = the categories of filter.var
tryCatch({
filter.levels <- names(impute.values)
# Validation
stopifnot(class(impute.var) == class(impute.values),
length(impute.values) > 0,
sum(is.na(impute.values)) == 0)
# Impute values
for(level in filter.levels){
impute.var[which(filter.var == level & is.na(impute.var))] <-
impute.values[level]
}
# Check if all NAs removed. Throw warning if not.
if(sum(is.na(impute.var)) > 0){
warning("Not all NAs removed")
}
# Return values
return(impute.var)
},
error = function(err) print(paste0("ImputeValues: ",err)),
warning = function(war) print(paste0("ImputeValues: ",war))
)
}
impute.var and filter.var are vectors taken from a data.frame (they are vectors of Ages and Titles (e.g. 'Mr', 'Mrs')
impute.values is a vector of the same type as impute.var but with labels taken from filter.var (i.e. is of the form c('Mr' = 30, 'Mrs' = 25...))
The problem
To check if my validation was working I supplied the function with a named vector of NAs, thusly:
ages <- c(34, 22, NA, 17, 38, NA)
titles <- c("Mr", "Mr", "Mr", "Mrs", "Mrs", "Mrs")
ages.values <- c("Mr" = NA, "Mrs" = NA)
ages.new <- ImputeVariables(ages, ages.values, titles)
print(ages.new)
But it outputs the following:
"ImputeValues: Error: class(impute.var) == class(impute.values) is not TRUE\n"
"ImputeValues: Error: class(impute.var) == class(impute.values) is not TRUE\n"
The two lines are due to the function printing the ages.new vector and the following print statement printing ages.new (why?)
If I comment out the validation (the stopifnot function) then I just get:
"ImputeValues: simpleWarning in doTryCatch(return(expr), name, parentenv, handler): Not all NAs removed\n"
What I'm asking
Why does the tryCatch block behave this way?
Is my validation and error handling strategy optimal (obviously without the bug)?
Many thanks for your time.
Rob
Thanks Oliver.
The working code is now:
ImputeVariables <- function(impute.var, impute.values,
filter.var){
# function to impute values.
# impute.var = variables with NAs
# impute.values = the missing value(s) to replace NAs, value labesl are levels
# filter.var = the variables to filter on.
# filter.levels = the categories of filter.var
tryCatch({
filter.levels <- names(impute.values)
# Validation
stopifnot(class(impute.var) == class(impute.values),
length(impute.values) > 0,
sum(is.na(impute.values)) == 0)
# Impute values
for(level in filter.levels){
impute.var[which(filter.var == level & is.na(impute.var))] <-
impute.values[level]
}
# Check if all NAs removed. Throw warning if not.
if(sum(is.na(impute.var)) > 0){
warning("Not all NAs removed")
}
# Return values
return(impute.var)
},
error = function(err) stop(paste0("ImputeValues: ",err)),
warning = function(war) {
message(paste0("ImputeValues: ",war))
return(impute.var)}
)
}
This is essentially two different problems. The first problem is that print statements within a function do not print to the terminal, they print to the scope of the function. As an example:
> foo <- function(){
print("bar")
}
> foo()
[1] "bar"
It didn't print "bar" to your screen, it printed it to the function scope and then returned it. The reason it returned it was that it was the last value printed to the function scope, and so (lacking an explicit return() call) is the best candidate for what to return.
So, your code is (in sequence):
Throwing an error;
Not treating that error normally, but instead passing it into tryCatch's error handler, where it is printed;
Because it is the last thing printed within the function scope, since the return() statement is never hit due to the error, treating it as the return value from the function.
If you really want to continue processing the input values even if the stopifnot() conditions are met, you don't want a stopifnot(): however you structure that it's likely to prevent the return() call from running and cause weirdness. What I'd suggest is instead moving the conditional checks currently in stopifnot() outside the tryCatch, and sticking them in a series of if() statements that throw warnings (not errors) if they don't match up. tryCatch isn't really necessary in this situation.
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!