conbining two functions in r (using tryCatch) - r

I want to make a new function that has 3 skills
if an error occurs, print "error". Do not stop the whole process, make it keep going
if a warning occurs, print the warning message
if there is no error nor warning, print "Nothing".
For 1) I made a function as follows:
efunc <- function(error){
return(NA)
}
tryc <- function(x){tryCatch(x, error = efunc)}
for 2), 3) , I refer to this page( How do I save warnings and errors as output from a function?) and
adapted some code, making the following functions
myTryCatch <- function(expr) {
warn <- err <- NULL
value <- withCallingHandlers(
tryCatch(expr, error=function(e) {
err <<- e # <<- is not typo
print("error")
}), warning=function(w) {
warn <<- w # <<- is not typo
invokeRestart("muffleWarning")
})
if(is.null(warn)){
warn<-'Nothing'
}
if(is.null(err)){
err<-'Nothing'
}
warning=warn
paste(unlist(warning),collapse="")
}
However, thinking back, maybe it is possible to combine these two functions..
or, myTryCatch() already has a tryc()'s skill..
but I am not sure.

Related

If observe warning, skip iteration in for loop [R]

I have some loop that computes a value. Sometimes that computation triggers a warning. How do I check if the warning is triggered, then skip that iteration? I am using R.
With help from the comments, I found tryCatch() and was able to amend my for loop as the following and work:
for (i in seq(1,100,1)){
x<-sample(1:length(df$values), 1)
input<-copy_df[x:x+5,]
val<-tryCatch(myfunc(input$colA), warning=function(w) w)
if (is(val,warning){
next
}
print(paste0(i))
}
The output of val should be a column of length 5.
Here's a complete example using a test function that randomly generates a warning
set.seed(101)
foo <- function() {
x <- runif(1)
if(x<.9) warning("low x")
x
}
for(i in 1:20) {
didwarn <- tryCatch({x <- foo(); FALSE}, warning = function(w) return(TRUE))
if(didwarn) {
next
}
print(paste("high x", x))
}
You wrap any code that might trigger a warning in a try catch. Here we have each block return TRUE or FALSE depending on whether or not an error was thrown. An easier way to do this without the next would be
for(i in 1:20) {
tryCatch({
x <- foo();
print(paste("high x", x))
},
warning = function(w) {
# do nothing
})
}
When the warning occurs, nothing else in the tryCatch expression will run

tryCatch and "promise already under evaluation" [duplicate]

I'm using lapply to run a complex function on a large number of items, and I'd like to save the output from each item (if any) together with any warnings/errors that were produced so that I can tell which item produced which warning/error.
I found a way to catch warnings using withCallingHandlers (described here). However, I need to catch errors as well. I can do it by wrapping it in a tryCatch (as in the code below), but is there a better way to do it?
catchToList <- function(expr) {
val <- NULL
myWarnings <- NULL
wHandler <- function(w) {
myWarnings <<- c(myWarnings, w$message)
invokeRestart("muffleWarning")
}
myError <- NULL
eHandler <- function(e) {
myError <<- e$message
NULL
}
val <- tryCatch(withCallingHandlers(expr, warning = wHandler), error = eHandler)
list(value = val, warnings = myWarnings, error=myError)
}
Sample output of this function is:
> catchToList({warning("warning 1");warning("warning 2");1})
$value
[1] 1
$warnings
[1] "warning 1" "warning 2"
$error
NULL
> catchToList({warning("my warning");stop("my error")})
$value
NULL
$warnings
[1] "my warning"
$error
[1] "my error"
There are several questions here on SO that discuss tryCatch and error handling, but none that I found that address this particular issue. See How can I check whether a function call results in a warning?, warnings() does not work within a function? How can one work around this?, and How to tell lapply to ignore an error and process the next thing in the list? for the most relevant ones.
Maybe this is the same as your solution, but I wrote a factory to convert plain old functions into functions that capture their values, errors, and warnings, so I can
test <- function(i)
switch(i, "1"=stop("oops"), "2"={ warning("hmm"); i }, i)
res <- lapply(1:3, factory(test))
with each element of the result containing the value, error, and / or warnings. This would work with user functions, system functions, or anonymous functions (factory(function(i) ...)). Here's the factory
factory <- function(fun)
function(...) {
warn <- err <- NULL
res <- withCallingHandlers(
tryCatch(fun(...), error=function(e) {
err <<- conditionMessage(e)
NULL
}), warning=function(w) {
warn <<- append(warn, conditionMessage(w))
invokeRestart("muffleWarning")
})
list(res, warn=warn, err=err)
}
and some helpers for dealing with the result list
.has <- function(x, what)
!sapply(lapply(x, "[[", what), is.null)
hasWarning <- function(x) .has(x, "warn")
hasError <- function(x) .has(x, "err")
isClean <- function(x) !(hasError(x) | hasWarning(x))
value <- function(x) sapply(x, "[[", 1)
cleanv <- function(x) sapply(x[isClean(x)], "[[", 1)
Try the evaluate package.
library(evaluate)
test <- function(i)
switch(i, "1"=stop("oops"), "2"={ warning("hmm"); i }, i)
t1 <- evaluate("test(1)")
t2 <- evaluate("test(2)")
t3 <- evaluate("test(3)")
It currently lacks a nice way of evaluating expression though - this is mainly because it's targetted towards reproducing exactly what R output's given text input at the console.
replay(t1)
replay(t2)
replay(t3)
It also captures messages, output to the console, and ensures that everything is correctly interleaved in the order in which it occurred.
I have merged Martins soulution (https://stackoverflow.com/a/4952908/2161065) and the one from the R-help mailing list you get with demo(error.catching).
The main idea is to keep both, the warning/error message as well as the command triggering this problem.
myTryCatch <- function(expr) {
warn <- err <- NULL
value <- withCallingHandlers(
tryCatch(expr, error=function(e) {
err <<- e
NULL
}), warning=function(w) {
warn <<- w
invokeRestart("muffleWarning")
})
list(value=value, warning=warn, error=err)
}
Examples:
myTryCatch(log(1))
myTryCatch(log(-1))
myTryCatch(log("a"))
Output:
myTryCatch(log(1))
# $value
# [1] 0
#
# $warning
# NULL
#
# $error
# NULL
myTryCatch(log(-1))
# $value
# [1] NaN
#
# $warning
# <simpleWarning in log(-1): NaNs produced>
#
# $error
# NULL
myTryCatch(log("a"))
# $value
# NULL
#
# $warning
# NULL
#
# $error
# <simpleError in log("a"): non-numeric argument to mathematical function>
The purpose of my answer (and modification to Martin's excellent code) is so that the factory-ed function returns the data structure expected if all goes well. If a warning is experienced, it is attached to the result under the factory-warning attribute. data.table's setattr function is used to allow for compatibility with that package. If an error is experienced, the result is the character element "An error occurred in the factory function" and the factory-error attribute will carry the error message.
#' Catch errors and warnings and store them for subsequent evaluation
#'
#' Factory modified from a version written by Martin Morgan on Stack Overflow (see below).
#' Factory generates a function which is appropriately wrapped by error handlers.
#' If there are no errors and no warnings, the result is provided.
#' If there are warnings but no errors, the result is provided with a warn attribute set.
#' If there are errors, the result retutrns is a list with the elements of warn and err.
#' This is a nice way to recover from a problems that may have occurred during loop evaluation or during cluster usage.
#' Check the references for additional related functions.
#' I have not included the other factory functions included in the original Stack Overflow answer because they did not play well with the return item as an S4 object.
#' #export
#' #param fun The function to be turned into a factory
#' #return The result of the function given to turn into a factory. If this function was in error "An error as occurred" as a character element. factory-error and factory-warning attributes may also be set as appropriate.
#' #references
#' \url{http://stackoverflow.com/questions/4948361/how-do-i-save-warnings-and-errors-as-output-from-a-function}
#' #author Martin Morgan; Modified by Russell S. Pierce
#' #examples
#' f.log <- factory(log)
#' f.log("a")
#' f.as.numeric <- factory(as.numeric)
#' f.as.numeric(c("a","b",1))
factory <- function (fun) {
errorOccurred <- FALSE
library(data.table)
function(...) {
warn <- err <- NULL
res <- withCallingHandlers(tryCatch(fun(...), error = function(e) {
err <<- conditionMessage(e)
errorOccurred <<- TRUE
NULL
}), warning = function(w) {
warn <<- append(warn, conditionMessage(w))
invokeRestart("muffleWarning")
})
if (errorOccurred) {
res <- "An error occurred in the factory function"
}
if (is.character(warn)) {
data.table::setattr(res,"factory-warning",warn)
} else {
data.table::setattr(res,"factory-warning",NULL)
}
if (is.character(err)) {
data.table::setattr(res,"factory-error",err)
} else {
data.table::setattr(res, "factory-error", NULL)
}
return(res)
}
}
Because we don't wrap the result in an extra list we can't make the kind of assumptions that allow for some of his accessor functions, but we can write simple checks and decide how to handle the cases as is appropriate to our particular resulting data-structure.
.has <- function(x, what) {
!is.null(attr(x,what))
}
hasWarning <- function(x) .has(x, "factory-warning")
hasError <- function(x) .has(x, "factory-error")
isClean <- function(x) !(hasError(x) | hasWarning(x))

How to catch warning and still run the expression

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

How to access function arguments (if function is passed as string) in R

warn <- NULL
withwarn <- function(fun) { tryCatch(fun, warning=function(w) {
warn <<- append(warn, paste(time, conditionMessage(w))) } )}
withwarn(reqHistoricalData(tws,x,time,'1 min','5 D','0','HISTORICAL_VOLATILITY'))
I pass a function to tryCatch and would like to have the value of argument time
I tried several proposed ways with sys.call etc. but it seems that my problem is different: to function(w), time is not passed, and in function(fun) time is only part of the function string (only evaluated in tryCatch later on)
EDIT (Work-Around):
I just added another argument withwarn <- function(fun,y) for time.
How about this:
warn <- NULL
withwarn <- function(fun) {
args <- match.call()
time_arg <- if("time" %in% names(args[[2]]))
eval(args[[2]][["time"]])
else {
eval(args[[2]][[4]])
}
tryCatch(fun, warning=function(w) { warn <<- append(warn, paste(time_arg, conditionMessage(w))) } )
}
reqHistoricalData <- function(tws, x, time, ...) warning("some warning.")
ans <- withwarn(reqHistoricalData(tws, x, Sys.time(), '1 min','5 D','0','HISTORICAL_VOLATILITY'))
However, your workaround in your question looks better/cleaner to me.

r tryCatch how to pass object to error function

myFunc <- function(x)
{
x <- timeSeries(x, charvec=as.Date(index(x)))
t<-tryCatch( doSomething(x), error=function(x) rep(0,ncol(x))
)
t
}
How do I pass x into the error function? When I run the above I get:
Error in rep(0, ncol(x)) : invalid 'times' argument
The error argument is a handler, documented (see ?tryCatch) to accept one argument (the error condition). The error handler has access to whatever variables were available at the time stop was invoked. So
f = function() {
tryCatch({
i = 1
stop("oops")
}, error=function(e) {
stop(conditionMessage(e), " when 'i' was ", i)
})
}
catches the error thrown by the code, discovers the value i, and emits a more informative message. So I'd guess
myFunc <- function(x)
{
tryCatch({
x <- timeSeries(x, charvec=as.Date(index(x)))
doSomething(x)
}, error=function(...) rep(0, ncol(x)))
}

Resources