related to this question. I wanted to build a simple lapply function that will output NULL if an error occur.
my first thought was to do something like
lapply_with_error <- function(X,FUN,...){
lapply(X,tryCatch({FUN},error=function(e) NULL))
}
tmpfun <- function(x){
if (x==9){
stop("There is something strange in the neiborhood")
} else {
paste0("This is number", x)
}
}
tmp <- lapply_with_error(1:10,tmpfun )
But tryCatch does not capture the error it seems. Any ideas?
You need to provide lapply with a function:
lapply_with_error <- function(X,FUN,...){
lapply(X, function(x, ...) tryCatch(FUN(x, ...),
error=function(e) NULL))
}
Related
Consider the function
f <- function(x, X) mean(c(x,X))
How can I automatically (by manipulation of f()) change the signature of f() such that it can be used with lapply(), i.e., without returning the following obvious error?
lapply(X=list(1), FUN=f, X=1)
Error in lapply(X = list(1), FUN = f, X = 1) :
formal argument "X" matched by multiple actual arguments
The approach I used so far is to remove all arguments from f(), assign them into an environment, and evaluatef() in that environment.
integrateArgs <- function (f, args)
{
form <- formals(f)
if (!is.null(form))
for (i in seq_along(form)) assign(names(form)[i], form[[i]])
if (!is.null(args))
for (i in seq_along(args)) assign(names(args)[i], args[[i]])
ff <- function() {
}
parent.env(environment(ff)) <- parent.env(environment(f))
body(ff) <- body(f)
if (any(names(form) == "..."))
formals(ff) <- form[names(form) == "..."]
ff
}
fnew <- integrateArgs(f, list(x=1, X=4))
lapply(list(fnew), function(x) x())
[[1]]
[1] 2.5
However, that approach leads to the following error if f() is a function from another R package that calls compiled code.
fnew2 <- integrateArgs(dnorm, list(x=1, mean=4))
lapply(list(fnew2), function(x) x())
Error in x() (from #1) : object 'C_dnorm' not found
Are there better solutions?
As suggested in a comment by MrFlick, one solution is
library(purrr)
integrateArgs <- function(f, args){
do.call(partial, c(list(f), args))
}
fnew2 <- integrateArgs(dnorm, list(x=1, mean=4))
lapply(list(fnew2), function(x) x())
[[1]]
[1] 0.004431848
The following similar approach does not require the package purrr:
integrateArgs <- function(f, args){
do.call(function(f, ...) {
eval(call("function", NULL,
substitute(f(...))), envir = environment(f))},
c(f = list(f), args))
}
fnew2 <- integrateArgs(dnorm, list(x=1, mean=4))
lapply(list(fnew2), function(x) x())
[[1]]
[1] 0.004431848
A similar approach is now used in optimParallel version 0.7-4 to execute functions in parallel using parallel::parLapply(): https://cran.r-project.org/package=optimParallel
I am trying to incorporate a tryCatch function in my R code to prevent the loop from breaking whenever I get an error.
I've looked through other examples but can't make applying tryCatch work.
Does anyone know how to add tryCatch to the following loop to prevent any error stopping the loop continuing?
for (i in (1:nrow(pagedata))) {
u <- pagedata[i, "id"]
url <- paste0("https://www.google.com/", u)
r <- GET(url)
print(url)
if (!http_error(r)) {
web_page_read_follows <- read.csv(url)
colnames(web_page_read_follows) <- "follows"
web_page_collect_follows <- web_page_read_follows[web_page_read_follows$follows %like% "Followers", ]
web_page_collect_follows <- as.data.frame(web_page_collect_follows)
colnames(web_page_collect_follows) <- "follows"
web_page_collect_follows$follows <- gsub("Followers.*", "", web_page_collect_follows$follows)
web_page_collect_follows$follows <- gsub(".*=", "", web_page_collect_follows$follows)
web_page_collect_follows <- tail(web_page_collect_follows, -(nrow(web_page_collect_follows) - 1))
if (length(web_page_collect_follows$follows) > 0) {
pagedata[i, "followers"] <- web_page_collect_follows$follows
print(i)
Sys.sleep(1)
}
}
}
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.
I have a drawing function f that should not return any output.
f <- function(a=0) invisible(NULL)
f(10)
After vectorizing f, it does return NULL.
f_vec <- Vectorize(f)
f_vec(10)
[[1]]
NULL
How can I prevent this, i.e. make the output invisible here as well.
I could of course use a wrapper to suppress it.
f_wrapper <- function(a=0) {
dummy <- f_vec(a)
}
f_wrapper(10)
Is there a way to avoid the wrapper and get what I want straight away?
Yeah there is. This new version of Vectorize will do it:
Vectorize_2 <- function (FUN, vectorize.args = arg.names, SIMPLIFY = TRUE, USE.NAMES = TRUE) {
arg.names <- as.list(formals(FUN))
arg.names[["..."]] <- NULL
arg.names <- names(arg.names)
vectorize.args <- as.character(vectorize.args)
if (!length(vectorize.args))
return(FUN)
if (!all(vectorize.args %in% arg.names))
stop("must specify names of formal arguments for 'vectorize'")
FUNV <- function() {
args <- lapply(as.list(match.call())[-1L], eval, parent.frame())
names <- if (is.null(names(args)))
character(length(args))
else names(args)
dovec <- names %in% vectorize.args
invisible(do.call("mapply", c(FUN = FUN, args[dovec], MoreArgs = list(args[!dovec]),
SIMPLIFY = SIMPLIFY, USE.NAMES = USE.NAMES)))
}
formals(FUNV) <- formals(FUN)
FUNV
}
But, how did I know to do this? Did I spend 20 minutes writing a brand new version of Vectorize? NOPE! I just ran dput(Vectorize) to see the R code behind Vectorize and added the invisible where necessary! You can do this with all R functions. You don't even need the dput! Just run Vectorize!
I'm trying to write some S3 methods, and I'd like them to share common error handling code. This seemed like the obvious way to me:
myMethod <- function(x) {
tryCatch(UseMethod("myMethod", x), error=function(e) paste("Caught:", e))
}
myMethod.default <- function(x) print("Default.")
But it doesn't work, since UseMethod doesn't like being wrapped in tryCatch:
myMethod(0)
[1] "Caught: Error in UseMethod(\"myMethod\", x): 'UseMethod' used in an inappropriate fashion\n"
Does anyone have any advice on where to go from here?
Just wrap it.
myMethod <- function(x) {
fn <- function() UseMethod("myMethod", x)
tryCatch(fn(), error = function(e) paste("Caught:", e))
}
myMethod.default <- function(x) print("Default.")
myMethod(structure('1', class='default'))
# [1] "Default."