How to use the `sink` function within another function in R? - r

I have a function fun that relies on an external function external (i.e., from some package). How can I collect all the warnings that come out of external in a character vector?
This is a minimal setup:
# External function from another package.
external <- function() {
warning("warning from external...")
}
# Function meant to capture the warnings.
fun <- function() {
# Create variable to store the warnings.
warns <- vector("character")
# Create connection for the sink.
connection <- textConnection("warns", "wr", local = TRUE)
# Start collecting.
sink(connection, type = "message")
# Call external function and produce a warning.
external()
# Reset the sink.
sink(type = "message")
# Close the connection.
close(connection)
return(warns)
}
The output, however looks like this:
x <- fun()
# Warning message:
# In external() : warning from external...
print(x)
# character(0)
I am not interested in suppressWarnings, but rather to log these warnings. When I use sink outside of a function it seems to work, just as indicated in this answer.

You can use tryCatch for this:
fun <- function() {
tryCatch(external(), warning = function(my_warn) my_warn$message)
}
x <-fun()
x
# [1] "warning from external..."

You can try evaluate() function from evaluate package, if you want to store warnings in a character vector:
external <- function() {
warning("warning from external...")
}
# Function meant to capture the warnings.
fun <- function() {
#some operation
x=1+2;
warnings_ls = evaluate::evaluate(external())
return(list(value=x,warn=warnings_ls))
}
x <- fun()
> a$warn[[1]]$src
[1] "warning from external..."
> a$value
[1] 3

Supplementing the answers above, the warn option (see ?options) says:
sets the handling of warning messages. If warn is negative all warnings are ignored. If warn is zero (the default) warnings are stored until the top–level function returns. If 10 or fewer warnings were signalled they will be printed otherwise a message saying how many were signalled. An object called last.warning is created and can be printed through the function warnings. If warn is one, warnings are printed as they occur. If warn is two or larger all warnings are turned into errors.
In that sense, setting options(warn = 1) before the sink makes it possible for the warning messages can be captured. The warn can be reverted to default after resetting the sink (i.e., options(warn = 0)). Then, fun would look something like:
fun <- function() {
# Print warnings as they occur.
options(warn = 1)
# Create variable to store the warnings.
warns <- vector("character")
# Create connection for the sink.
connection <- textConnection("warns", "wr", local = TRUE)
# Start collecting.
sink(connection, type = "message")
# Call external function and produce a warning.
external()
# Reset the sink.
sink(type = "message")
# Close the connection.
close(connection)
# Restore default warning behavior.
options(warn = 0)
return(warns)
}
With the following output:
fun()
# [1] "Warning in external() : warning from external..."

Related

Does code in R throw a warning? Can I expect warning? [duplicate]

In R, how can I determine whether a function call results in a warning?
That is, after calling the function I would like to know whether that instance of the call yielded a warning.
If you want to use the try constructs, you can set the options for warn. See also ?options. Better is to use tryCatch() :
x <- function(i){
if (i < 10) warning("A warning")
i
}
tt <- tryCatch(x(5),error=function(e) e, warning=function(w) w)
tt2 <- tryCatch(x(15),error=function(e) e, warning=function(w) w)
tt
## <simpleWarning in x(5): A warning>
tt2
## [1] 15
if(is(tt,"warning")) print("KOOKOO")
## [1] "KOOKOO"
if(is(tt2,"warning")) print("KOOKOO")
To get both the result and the warning :
tryCatch(x(5),warning=function(w) return(list(x(5),w)))
## [[1]]
## [1] 5
##
## [[2]]
## <simpleWarning in x(5): A warning>
Using try
op <- options(warn=2)
tt <- try(x())
ifelse(is(tt,"try-error"),"There was a warning or an error","OK")
options(op)
On the R-help mailing list (see http://tolstoy.newcastle.edu.au/R/help/04/06/0217.html), Luke Tierney wrote:
"If you want to write a function that computes a value and collects all
warning you could do it like this:
withWarnings <- function(expr) {
myWarnings <- NULL
wHandler <- function(w) {
myWarnings <<- c(myWarnings, list(w))
invokeRestart("muffleWarning")
}
val <- withCallingHandlers(expr, warning = wHandler)
list(value = val, warnings = myWarnings)
}
2019 update
You can you use 'quietly' from the purrr package, which returns a list of output, result, warning and error. You can then extract each element by name. For instance, if you had a list, which you want to map a function over, and find the elements which returned a warning you could do
library(purrr)
library(lubridate)
datelist <- list(a = "12/12/2002", b = "12-12-2003", c = "24-03-2005")
# get all the everything
quiet_list <- map(datelist, quietly(mdy))
# find the elements which produced warnings
quiet_list %>% map("warnings") %>% keep(~ !is.null(.))
# or
quiet_list %>% keep(~ length(.$warnings) != 0)
For this example it's quite trivial, but for a long list of dataframes where the NAs might be hard to spot, this is quite useful.
here is an example:
testit <- function() warning("testit") # function that generates warning.
assign("last.warning", NULL, envir = baseenv()) # clear the previous warning
testit() # run it
if(length(warnings())>0){ # or !is.null(warnings())
print("something happened")
}
maybe this is somehow indirect, but i don't know the more straightforward way.
For a simple TRUE/FALSE return on whether a given operation results in a warning (or error), you could use the is.error function from the berryFunctions package, after first setting options(warn = 2) so that warnings are converted to errors.
E.g.,
options(warn = 2)
berryFunctions::is.error(as.numeric("x")) # TRUE
berryFunctions::is.error(as.numeric("3")) # FALSE
If you want to limit the option change to the use of this function, you could just create a new function as follows.
is.warningorerror <- function(x) {
op <- options()
on.exit(options(op))
options(warn = 2)
berryFunctions::is.error(x)
}
is.warningorerror(as.numeric("x")) # TRUE
options("warn") # still 0 (default)
I personally use the old good sink redirected into a text connection:
# create a new text connection directed into a variable called 'messages'
con <- textConnection("messages","w")
# sink all messages (i.e. warnings and errors) into that connection
sink(con,type = "message")
# a sample warning-generating function
test.fun <- function() {
warning("Your warning.")
return("Regular output.")
}
output <- test.fun()
# close the sink
sink(type="message")
# close the connection
close(con)
# if the word 'Warning' appears in messages than there has been a warning
warns <- paste(messages,collapse=" ")
if(grepl("Warning",warns)) {
print(warns)
}
# [1] "Warning message: In test.fun() : Your warning."
print(output)
# [1] "Regular output."
Possibly more straightforward and cleaner than the other suggested solutions.

How to use tryCatch() in R with parallel code? [duplicate]

I want to write trycatch code to deal with error in downloading from the web.
url <- c(
"http://stat.ethz.ch/R-manual/R-devel/library/base/html/connections.html",
"http://en.wikipedia.org/wiki/Xz")
y <- mapply(readLines, con=url)
These two statements run successfully. Below, I create a non-exist web address:
url <- c("xxxxx", "http://en.wikipedia.org/wiki/Xz")
url[1] does not exist. How does one write a trycatch loop (function) so that:
When the URL is wrong, the output will be: "web URL is wrong, can't get".
When the URL is wrong, the code does not stop, but continues to download until the end of the list of URLs?
Well then: welcome to the R world ;-)
Here you go
Setting up the code
urls <- c(
"http://stat.ethz.ch/R-manual/R-devel/library/base/html/connections.html",
"http://en.wikipedia.org/wiki/Xz",
"xxxxx"
)
readUrl <- function(url) {
out <- tryCatch(
{
# Just to highlight: if you want to use more than one
# R expression in the "try" part then you'll have to
# use curly brackets.
# 'tryCatch()' will return the last evaluated expression
# in case the "try" part was completed successfully
message("This is the 'try' part")
readLines(con=url, warn=FALSE)
# The return value of `readLines()` is the actual value
# that will be returned in case there is no condition
# (e.g. warning or error).
# You don't need to state the return value via `return()` as code
# in the "try" part is not wrapped inside a function (unlike that
# for the condition handlers for warnings and error below)
},
error=function(cond) {
message(paste("URL does not seem to exist:", url))
message("Here's the original error message:")
message(cond)
# Choose a return value in case of error
return(NA)
},
warning=function(cond) {
message(paste("URL caused a warning:", url))
message("Here's the original warning message:")
message(cond)
# Choose a return value in case of warning
return(NULL)
},
finally={
# NOTE:
# Here goes everything that should be executed at the end,
# regardless of success or error.
# If you want more than one expression to be executed, then you
# need to wrap them in curly brackets ({...}); otherwise you could
# just have written 'finally=<expression>'
message(paste("Processed URL:", url))
message("Some other message at the end")
}
)
return(out)
}
Applying the code
> y <- lapply(urls, readUrl)
Processed URL: http://stat.ethz.ch/R-manual/R-devel/library/base/html/connections.html
Some other message at the end
Processed URL: http://en.wikipedia.org/wiki/Xz
Some other message at the end
URL does not seem to exist: xxxxx
Here's the original error message:
cannot open the connection
Processed URL: xxxxx
Some other message at the end
Warning message:
In file(con, "r") : cannot open file 'xxxxx': No such file or directory
Investigating the output
> head(y[[1]])
[1] "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">"
[2] "<html><head><title>R: Functions to Manipulate Connections</title>"
[3] "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\">"
[4] "<link rel=\"stylesheet\" type=\"text/css\" href=\"R.css\">"
[5] "</head><body>"
[6] ""
> length(y)
[1] 3
> y[[3]]
[1] NA
Additional remarks
tryCatch
tryCatch returns the value associated to executing expr unless there's an error or a warning. In this case, specific return values (see return(NA) above) can be specified by supplying a respective handler function (see arguments error and warning in ?tryCatch). These can be functions that already exist, but you can also define them within tryCatch() (as I did above).
The implications of choosing specific return values of the handler functions
As we've specified that NA should be returned in case of error, the third element in y is NA. If we'd have chosen NULL to be the return value, the length of y would just have been 2 instead of 3 as lapply() will simply "ignore" return values that are NULL. Also note that if you don't specify an explicit return value via return(), the handler functions will return NULL (i.e. in case of an error or a warning condition).
"Undesired" warning message
As warn=FALSE doesn't seem to have any effect, an alternative way to suppress the warning (which in this case isn't really of interest) is to use
suppressWarnings(readLines(con=url))
instead of
readLines(con=url, warn=FALSE)
Multiple expressions
Note that you can also place multiple expressions in the "actual expressions part" (argument expr of tryCatch()) if you wrap them in curly brackets (just like I illustrated in the finally part).
tryCatch has a slightly complex syntax structure. However, once we understand the 4 parts which constitute a complete tryCatch call as shown below, it becomes easy to remember:
expr: [Required] R code(s) to be evaluated
error : [Optional] What should run if an error occured while evaluating the codes in expr
warning : [Optional] What should run if a warning occured while evaluating the codes in expr
finally : [Optional] What should run just before quitting the tryCatch call, irrespective of if expr ran successfully, with an error, or with a warning
tryCatch(
expr = {
# Your code...
# goes here...
# ...
},
error = function(e){
# (Optional)
# Do this if an error is caught...
},
warning = function(w){
# (Optional)
# Do this if an warning is caught...
},
finally = {
# (Optional)
# Do this at the end before quitting the tryCatch structure...
}
)
Thus, a toy example, to calculate the log of a value might look like:
log_calculator <- function(x){
tryCatch(
expr = {
message(log(x))
message("Successfully executed the log(x) call.")
},
error = function(e){
message('Caught an error!')
print(e)
},
warning = function(w){
message('Caught an warning!')
print(w)
},
finally = {
message('All done, quitting.')
}
)
}
Now, running three cases:
A valid case
log_calculator(10)
# 2.30258509299405
# Successfully executed the log(x) call.
# All done, quitting.
A "warning" case
log_calculator(-10)
# Caught an warning!
# <simpleWarning in log(x): NaNs produced>
# All done, quitting.
An "error" case
log_calculator("log_me")
# Caught an error!
# <simpleError in log(x): non-numeric argument to mathematical function>
# All done, quitting.
I've written about some useful use-cases which I use regularly. Find more details here: https://rsangole.netlify.com/post/try-catch/
Hope this is helpful.
R uses functions for implementing try-catch block:
The syntax somewhat looks like this:
result = tryCatch({
expr
}, warning = function(warning_condition) {
warning-handler-code
}, error = function(error_condition) {
error-handler-code
}, finally={
cleanup-code
})
In tryCatch() there are two ‘conditions’ that can be handled: ‘warnings’ and ‘errors’. The important thing to understand when writing each block of code is the state of execution and the scope.
#source
Here goes a straightforward example:
# Do something, or tell me why it failed
my_update_function <- function(x){
tryCatch(
# This is what I want to do...
{
y = x * 2
return(y)
},
# ... but if an error occurs, tell me what happened:
error=function(error_message) {
message("This is my custom message.")
message("And below is the error message from R:")
message(error_message)
return(NA)
}
)
}
If you also want to capture a "warning", just add warning= similar to the error= part.
Since I just lost two days of my life trying to solve for tryCatch for an irr function, I thought I should share my wisdom (and what is missing). FYI - irr is an actual function from FinCal in this case where got errors in a few cases on a large data set.
Set up tryCatch as part of a function. For example:
irr2 <- function (x) {
out <- tryCatch(irr(x), error = function(e) NULL)
return(out)
}
For the error (or warning) to work, you actually need to create a function. I originally for error part just wrote error = return(NULL) and ALL values came back null.
Remember to create a sub-output (like my "out") and to return(out).

Selective suppressWarnings() that filters by regular expression

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

Testing warnings in R by comparing strings (best idea?)

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()

How can I check whether a function call results in a warning?

In R, how can I determine whether a function call results in a warning?
That is, after calling the function I would like to know whether that instance of the call yielded a warning.
If you want to use the try constructs, you can set the options for warn. See also ?options. Better is to use tryCatch() :
x <- function(i){
if (i < 10) warning("A warning")
i
}
tt <- tryCatch(x(5),error=function(e) e, warning=function(w) w)
tt2 <- tryCatch(x(15),error=function(e) e, warning=function(w) w)
tt
## <simpleWarning in x(5): A warning>
tt2
## [1] 15
if(is(tt,"warning")) print("KOOKOO")
## [1] "KOOKOO"
if(is(tt2,"warning")) print("KOOKOO")
To get both the result and the warning :
tryCatch(x(5),warning=function(w) return(list(x(5),w)))
## [[1]]
## [1] 5
##
## [[2]]
## <simpleWarning in x(5): A warning>
Using try
op <- options(warn=2)
tt <- try(x())
ifelse(is(tt,"try-error"),"There was a warning or an error","OK")
options(op)
On the R-help mailing list (see http://tolstoy.newcastle.edu.au/R/help/04/06/0217.html), Luke Tierney wrote:
"If you want to write a function that computes a value and collects all
warning you could do it like this:
withWarnings <- function(expr) {
myWarnings <- NULL
wHandler <- function(w) {
myWarnings <<- c(myWarnings, list(w))
invokeRestart("muffleWarning")
}
val <- withCallingHandlers(expr, warning = wHandler)
list(value = val, warnings = myWarnings)
}
2019 update
You can you use 'quietly' from the purrr package, which returns a list of output, result, warning and error. You can then extract each element by name. For instance, if you had a list, which you want to map a function over, and find the elements which returned a warning you could do
library(purrr)
library(lubridate)
datelist <- list(a = "12/12/2002", b = "12-12-2003", c = "24-03-2005")
# get all the everything
quiet_list <- map(datelist, quietly(mdy))
# find the elements which produced warnings
quiet_list %>% map("warnings") %>% keep(~ !is.null(.))
# or
quiet_list %>% keep(~ length(.$warnings) != 0)
For this example it's quite trivial, but for a long list of dataframes where the NAs might be hard to spot, this is quite useful.
here is an example:
testit <- function() warning("testit") # function that generates warning.
assign("last.warning", NULL, envir = baseenv()) # clear the previous warning
testit() # run it
if(length(warnings())>0){ # or !is.null(warnings())
print("something happened")
}
maybe this is somehow indirect, but i don't know the more straightforward way.
For a simple TRUE/FALSE return on whether a given operation results in a warning (or error), you could use the is.error function from the berryFunctions package, after first setting options(warn = 2) so that warnings are converted to errors.
E.g.,
options(warn = 2)
berryFunctions::is.error(as.numeric("x")) # TRUE
berryFunctions::is.error(as.numeric("3")) # FALSE
If you want to limit the option change to the use of this function, you could just create a new function as follows.
is.warningorerror <- function(x) {
op <- options()
on.exit(options(op))
options(warn = 2)
berryFunctions::is.error(x)
}
is.warningorerror(as.numeric("x")) # TRUE
options("warn") # still 0 (default)
I personally use the old good sink redirected into a text connection:
# create a new text connection directed into a variable called 'messages'
con <- textConnection("messages","w")
# sink all messages (i.e. warnings and errors) into that connection
sink(con,type = "message")
# a sample warning-generating function
test.fun <- function() {
warning("Your warning.")
return("Regular output.")
}
output <- test.fun()
# close the sink
sink(type="message")
# close the connection
close(con)
# if the word 'Warning' appears in messages than there has been a warning
warns <- paste(messages,collapse=" ")
if(grepl("Warning",warns)) {
print(warns)
}
# [1] "Warning message: In test.fun() : Your warning."
print(output)
# [1] "Regular output."
Possibly more straightforward and cleaner than the other suggested solutions.

Resources