I have a rather complicated situation where I may end up passing a variable that doesn't exist to a function. I have a pretty good idea when this will happen, and fixing it will be difficult; I would be satisfied with being able to detect the condition reliably and executing a workaround in that case. I could simply use
inherits(try(eval(possibly_missing_variable),silent=TRUE),"try-error")
but if possible I would like to test for the specific condition that leads to the error object 'possibly_missing_variable' not found. (I could try to grep for "not found" in the error message, but I have been admonished on the r-devel list in the past that this will fail if R is being run in a different language so that a translated version of the error message appears.)
I've tried various combinations of deparse(substitute(...)), but they don't seem to run far enough up the call stack. Here's my best shot at a reproducible example:
f <- function(d) {
## test here
cat("'d' exists:",exists("d"),"\n") ## TRUE
cat("deparse(substitute(d)):",dd <- deparse(substitute(d)),"\n") ## OK
cat("exists('",dd,"'): ",exists(dd),"\n",sep="")
eval(d)
}
f2 <- function(ddd) {
f(ddd)
}
ddd <- 5
f2(junk)
The results are:
'd' exists: TRUE
deparse(substitute(d)): ddd
exists('ddd'): TRUE
Error in eval(d) : object 'junk' not found
I want a test that will correctly inform me (before hitting the error) that the evaluation will fail because the relevant object can't be found anywhere in the stack of environments/enclosing environments etc.. Any ideas ... ?
More generally, is there a way to figure out the farthest-upstream name of an argument ("junk" in this case)? If I could do that, then exists(farthest_upstream_name) would solve my problem.
Perhaps something like this (stolen from my second answer to this question)?
f <- function(d) {
## test here
ff <- sys.frames()
ex <- substitute(d)
ii <- rev(seq_along(ff))
for(i in ii) {
ex <- eval(substitute(substitute(x, env=sys.frames()[[n]]),
env = list(x = ex, n=i)))
}
if(!exists(deparse(ex))) stop("Substitute real error action here")
eval(d)
}
f2 <- function(ddd) {
f(ddd)
}
ddd <- 5
f2(junk)
## Error in f(ddd) (from #10) : Substitute real error action here
I like Josh O'Brien's approach. However, using f as defined there, the "non-existence" error condition can be triggered even when the passed name does in fact have an active binding, if it was created local to some function within the call stack (rather than in the global environment). Also, though perhaps not specifically relevant to Ben's intended usage, the error will be triggered if the argument is an expression, not just a name.
A simple fix is to tweak Josh's function to include an is.symbol test:
f <- function(d) {
## test here
ff <- sys.frames()
ex <- substitute(d)
ii <- rev(seq_along(ff))
for(i in ii) {
ex <- eval(substitute(substitute(x, env=sys.frames()[[n]]),
env = list(x = ex, n=i)))
}
if(is.symbol(ex) && !exists(deparse(ex))) {
stop("Substitute real error action here")
}
eval(d)
}
The desired check still works:
f2 <- function(ddd) {
f(ddd)
}
f2(junk)
## Error in f(ddd) : Substitute real error action here
But the following two cases now pass through rather than yielding the error:
# case 1: argument to f is local to a calling function
f3 <- function() {
notjunk <- 999
f(notjunk)
}
f3()
## [1] 999
# case 2: argument to f is an expression
f2(5+5)
## [1] 10
What's happening in f is that after the repeated application of call-substitute-substitute, ex is set to the evaluated argument itself in case 1 above, and to the passed (albeit still unevaluated) call in case 2. In both cases, the exists test alone would fail because ex is not actually a name (aka symbol), but clearly non-existence is not a concern if we've been able to resolve beyond the name.
Related
I want to reattempt failing readLines fetches using tryCatch. This works as expected, as long as I don't wrap it inside a future.apply::future_lapply call for processing a list or vector.
The problem can be reproduced using this code:
read_lines_retrying <- function(url, attempts = 5, throttle = 5) {
result <- NA
while (is.na(result) && 0 < attempts) {
attempts <- attempts - 1
result <- tryCatch(
{
readLines(url)
},
error = function(cond) {
message("caught error:")
message(cond)
message("")
Sys.sleep(throttle)
return(NA)
}
)
}
if (is.na(result)) {
stop(paste("could not get URL ", url))
}
return(result)
}
urls <- c("http://nonexistant.nonexistant")
future.apply::future_lapply(urls, read_lines_retrying)
Of course, the code is meant to retry on transient readLines failures, while the example URL will always fail, but this way problem can be most easily seen. When using lapply instead of future.apply::future_lapply, it takes at least 5 seconds to complete because it waits 5 seconds after each of the 5 attempts. This in not the case with future.apply::future_lapply, demonstrating that the exception handling doesn't work.
What am I doing wrong, and how can I get tryCatch to work inside future.apply::future_lapply?
Author of futureverse here: This is an interesting problem.
Here's a minimal reproducible example:
boom <- function(x) {
tryCatch(stop("boom"), error = function(cond) {
message(1); message(cond); message(2)
})
}
y <- lapply(1L, FUN = boom)
## 1
## boom2
y <- future.apply::future_lapply(1L, FUN = boom)
## 1
## Error in doTryCatch(return(expr), name, parentenv, handler) : boom
We can even reproduce this with individual futures:
> y <- boom(1)
## 1
## boom2
> f <- future::future(boom(1))
> y <- future::value(f)
## 1
## Error in doTryCatch(return(expr), name, parentenv, handler) ## : boom
First of all, it turns out that it message(cond) that trigger this odd behavior. If you instead, for instance, use message(conditionMessage(cond)), it works fine.
UPDATE 2022-03-01: After asking about this on R-devel (thread 'message() and warning() circumvent calling handlers and signal the original class, e.g. an error' on 2022-03-01 (https://stat.ethz.ch/pipermail/r-devel/2022-March/081515.html)), I conclude that using message(e) where e is an error condition is incorrect and that one should use message(conditionMessage(e)).
Technical details below:
What happens is that message(cond) end up re-signalling the caught error (= cond). And, despite message() is muffling the error signal internally, it turns out that the future still detects it and takes it as a definite error.
I have a hunch what might be happening, but I cannot promise a quick solution. I'm now tracking this in https://github.com/HenrikBengtsson/future/issues/507. Until resolved, the workaround is: "avoid resignaling the error you just caught", i.e. don't call message(cond) or warning(cond) on an error condition.
Thanks a bunch for reporting this important issue.
PS. Please consider https://github.com/HenrikBengtsson/future/discussions for future discussions, because I'm only skimming StackOverflow occasionally.
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 trying to read a function call as a string and evaluate this function within another function. I'm using eval(parse(text = )) to evaluate the string. The function I'm calling in the string doesn't seem to have access to the environment in which it is nested. In the code below, my "isgreater" function finds the object y, defined in the global environment, but can't find the object x, defined within the function. Does anybody know why, and how to get around this? I have already tried adding the argument envir = .GlobalEnv to both of my evals, to no avail.
str <- "isgreater(y)"
isgreater <- function(y) {
return(eval(y > x))
}
y <- 4
test <- function() {
x <- 3
return(eval(parse(text = str)))
}
test()
Error:
Error in eval(y > x) : object 'x' not found
Thanks to #MrFlick and #r2evans for their useful and thought-provoking comments. As far as a solution, I've found that this code works. x must be passed into the function and cannot be a default value. In the code below, my function generates a list of results with the x variable being changed within the function. If anyone knows why this is, I would love to know.
str <- "isgreater(y, x)"
isgreater <- function(y, x) {
return(eval(y > x))
}
y <- 50
test <- function() {
list <- list()
for(i in 1:100) {
x <- i
bool <- eval(parse(text = str))
list <- append(list, bool)
}
return(list)
}
test()
After considering the points made by #r2evans, I have elected to change my approach to the problem so that I do not arrive at this string-parsing step. Thanks a lot, everyone.
I offer the following code, not as a solution, but rather as an insight into how R "works". The code does things that are quite dangerous and should only be examined for its demonstration of how to assert a value for x. Unfortunately, that assertion does destroy the x-value of 3 inside the isgreater-function:
str <- "isgreater(y)"
isgreater <- function(y) {
return(eval( y > x ))
}
y <- 4
test <- function() {
environment(isgreater)$x <- 5
return(eval(parse(text = str) ))
}
test()
#[1] FALSE
The environment<- function is used in the R6 programming paradigm. Take a look at ?R6 if you are interested in working with a more object-oriented set of structures and syntax. (I will note that when I first ran your code, there was an object named x in my workspace and some of my efforts were able to succeed to the extent of not throwing an error, but they were finding that length-10000 vector and filling up my console with logical results until I escaped the console. Yet another argument for passing both x and y to isgreater.)
This is probably not correct terminology, but hopefully I can get my point across.
I frequently end up doing something like:
myVar = 1
f <- function(myvar) { return(myVar); }
# f(2) = 1 now
R happily uses the variable outside of the function's scope, which leaves me scratching my head, wondering how I could possibly be getting the results I am.
Is there any option which says "force me to only use variables which have previously been assigned values in this function's scope"? Perl's use strict does something like this, for example. But I don't know that R has an equivalent of my.
EDIT: Thank you, I am aware of that I capitalized them differently. Indeed, the example was created specifically to illustrate this problem!
I want to know if there is a way that R can automatically warn me when I do this.
EDIT 2: Also, if Rkward or another IDE offers this functionality I'd like to know that too.
As far as I know, R does not provide a "use strict" mode. So you are left with two options:
1 - Ensure all your "strict" functions don't have globalenv as environment. You could define a nice wrapper function for this, but the simplest is to call local:
# Use "local" directly to control the function environment
f <- local( function(myvar) { return(myVar); }, as.environment(2))
f(3) # Error in f(3) : object 'myVar' not found
# Create a wrapper function "strict" to do it for you...
strict <- function(f, pos=2) eval(substitute(f), as.environment(pos))
f <- strict( function(myvar) { return(myVar); } )
f(3) # Error in f(3) : object 'myVar' not found
2 - Do a code analysis that warns you of "bad" usage.
Here's a function checkStrict that hopefully does what you want. It uses the excellent codetools package.
# Checks a function for use of global variables
# Returns TRUE if ok, FALSE if globals were found.
checkStrict <- function(f, silent=FALSE) {
vars <- codetools::findGlobals(f)
found <- !vapply(vars, exists, logical(1), envir=as.environment(2))
if (!silent && any(found)) {
warning("global variables used: ", paste(names(found)[found], collapse=', '))
return(invisible(FALSE))
}
!any(found)
}
And trying it out:
> myVar = 1
> f <- function(myvar) { return(myVar); }
> checkStrict(f)
Warning message:
In checkStrict(f) : global variables used: myVar
checkUsage in the codetools package is helpful, but doesn't get you all the way there.
In a clean session where myVar is not defined,
f <- function(myvar) { return(myVar); }
codetools::checkUsage(f)
gives
<anonymous>: no visible binding for global variable ‘myVar’
but once you define myVar, checkUsage is happy.
See ?codetools in the codetools package: it's possible that something there is useful:
> findGlobals(f)
[1] "{" "myVar" "return"
> findLocals(f)
character(0)
You need to fix the typo: myvar != myVar. Then it will all work...
Scope resolution is 'from the inside out' starting from the current one, then the enclosing and so on.
Edit Now that you clarified your question, look at the package codetools (which is part of the R Base set):
R> library(codetools)
R> f <- function(myVAR) { return(myvar) }
R> checkUsage(f)
<anonymous>: no visible binding for global variable 'myvar'
R>
Using get(x, inherits=FALSE) will force local scope.
myVar = 1
f2 <- function(myvar) get("myVar", inherits=FALSE)
f3 <- function(myvar){
myVar <- myvar
get("myVar", inherits=FALSE)
}
output:
> f2(8)
Error in get("myVar", inherits = FALSE) : object 'myVar' not found
> f3(8)
[1] 8
You are of course doing it wrong. Don't expect static code checking tools to find all your mistakes. Check your code with tests. And more tests. Any decent test written to run in a clean environment will spot this kind of mistake. Write tests for your functions, and use them. Look at the glory that is the testthat package on CRAN.
There is a new package modules on CRAN which addresses this common issue (see the vignette here). With modules, the function raises an error instead of silently returning the wrong result.
# without modules
myVar <- 1
f <- function(myvar) { return(myVar) }
f(2)
[1] 1
# with modules
library(modules)
m <- module({
f <- function(myvar) { return(myVar) }
})
m$f(2)
Error in m$f(2) : object 'myVar' not found
This is the first time I use it. It seems to be straightforward so I might include it in my regular workflow to prevent time consuming mishaps.
you can dynamically change the environment tree like this:
a <- 1
f <- function(){
b <- 1
print(b)
print(a)
}
environment(f) <- new.env(parent = baseenv())
f()
Inside f, b can be found, while a cannot.
But probably it will do more harm than good.
You can test to see if the variable is defined locally:
myVar = 1
f <- function(myvar) {
if( exists('myVar', environment(), inherits = FALSE) ) return( myVar) else cat("myVar was not found locally\n")
}
> f(2)
myVar was not found locally
But I find it very artificial if the only thing you are trying to do is to protect yourself from spelling mistakes.
The exists function searches for the variable name in the particular environment. inherits = FALSE tells it not to look into the enclosing frames.
environment(fun) = parent.env(environment(fun))
will remove the 'workspace' from your search path, leave everything else. This is probably closest to what you want.
#Tommy gave a very good answer and I used it to create 3 functions that I think are more convenient in practice.
strict
to make a function strict, you just have to call
strict(f,x,y)
instead of
f(x,y)
example:
my_fun1 <- function(a,b,c){a+b+c}
my_fun2 <- function(a,b,c){a+B+c}
B <- 1
my_fun1(1,2,3) # 6
strict(my_fun1,1,2,3) # 6
my_fun2(1,2,3) # 5
strict(my_fun2,1,2,3) # Error in (function (a, b, c) : object 'B' not found
checkStrict1
To get a diagnosis, execute checkStrict1(f) with optional Boolean parameters to show more ore less.
checkStrict1("my_fun1") # nothing
checkStrict1("my_fun2") # my_fun2 : B
A more complicated case:
A <- 1 # unambiguous variable defined OUTSIDE AND INSIDE my_fun3
# B unambiguous variable defined only INSIDE my_fun3
C <- 1 # defined OUTSIDE AND INSIDE with ambiguous name (C is also a base function)
D <- 1 # defined only OUTSIDE my_fun3 (D is also a base function)
E <- 1 # unambiguous variable defined only OUTSIDE my_fun3
# G unambiguous variable defined only INSIDE my_fun3
# H is undeclared and doesn't exist at all
# I is undeclared (though I is also base function)
# v defined only INSIDE (v is also a base function)
my_fun3 <- function(a,b,c){
A<-1;B<-1;C<-1;G<-1
a+b+A+B+C+D+E+G+H+I+v+ my_fun1(1,2,3)
}
checkStrict1("my_fun3",show_global_functions = TRUE ,show_ambiguous = TRUE , show_inexistent = TRUE)
# my_fun3 : E
# my_fun3 Ambiguous : D
# my_fun3 Inexistent : H
# my_fun3 Global functions : my_fun1
I chose to show only inexistent by default out of the 3 optional additions. You can change it easily in the function definition.
checkStrictAll
Get a diagnostic of all your potentially problematic functions, with the same parameters.
checkStrictAll()
my_fun2 : B
my_fun3 : E
my_fun3 Inexistent : H
sources
strict <- function(f1,...){
function_text <- deparse(f1)
function_text <- paste(function_text[1],function_text[2],paste(function_text[c(-1,-2,-length(function_text))],collapse=";"),"}",collapse="")
strict0 <- function(f1, pos=2) eval(substitute(f1), as.environment(pos))
f1 <- eval(parse(text=paste0("strict0(",function_text,")")))
do.call(f1,list(...))
}
checkStrict1 <- function(f_str,exceptions = NULL,n_char = nchar(f_str),show_global_functions = FALSE,show_ambiguous = FALSE, show_inexistent = TRUE){
functions <- c(lsf.str(envir=globalenv()))
f <- try(eval(parse(text=f_str)),silent=TRUE)
if(inherits(f, "try-error")) {return(NULL)}
vars <- codetools::findGlobals(f)
vars <- vars[!vars %in% exceptions]
global_functions <- vars %in% functions
in_global_env <- vapply(vars, exists, logical(1), envir=globalenv())
in_local_env <- vapply(vars, exists, logical(1), envir=as.environment(2))
in_global_env_but_not_function <- rep(FALSE,length(vars))
for (my_mode in c("logical", "integer", "double", "complex", "character", "raw","list", "NULL")){
in_global_env_but_not_function <- in_global_env_but_not_function | vapply(vars, exists, logical(1), envir=globalenv(),mode = my_mode)
}
found <- in_global_env_but_not_function & !in_local_env
ambiguous <- in_global_env_but_not_function & in_local_env
inexistent <- (!in_local_env) & (!in_global_env)
if(typeof(f)=="closure"){
if(any(found)) {cat(paste(f_str,paste(rep(" ",n_char-nchar(f_str)),collapse=""),":", paste(names(found)[found], collapse=', '),"\n"))}
if(show_ambiguous & any(ambiguous)) {cat(paste(f_str,paste(rep(" ",n_char-nchar(f_str)),collapse=""),"Ambiguous :", paste(names(found)[ambiguous], collapse=', '),"\n"))}
if(show_inexistent & any(inexistent)) {cat(paste(f_str,paste(rep(" ",n_char-nchar(f_str)),collapse=""),"Inexistent :", paste(names(found)[inexistent], collapse=', '),"\n"))}
if(show_global_functions & any(global_functions)){cat(paste(f_str,paste(rep(" ",n_char-nchar(f_str)),collapse=""),"Global functions :", paste(names(found)[global_functions], collapse=', '),"\n"))}
return(invisible(FALSE))
} else {return(invisible(TRUE))}
}
checkStrictAll <- function(exceptions = NULL,show_global_functions = FALSE,show_ambiguous = FALSE, show_inexistent = TRUE){
functions <- c(lsf.str(envir=globalenv()))
n_char <- max(nchar(functions))
invisible(sapply(functions,checkStrict1,exceptions,n_char = n_char,show_global_functions,show_ambiguous, show_inexistent))
}
What works for me, based on #c-urchin 's answer, is to define a script which reads all my functions and then excludes the global environment:
filenames <- Sys.glob('fun/*.R')
for (filename in filenames) {
source(filename, local=T)
funname <- sub('^fun/(.*).R$', "\\1", filename)
eval(parse(text=paste('environment(',funname,') <- parent.env(globalenv())',sep='')))
}
I assume that
all functions and nothing else are contained in the relative directory ./fun and
every .R file contains exactly one function with an identical name as the file.
The catch is that if one of my functions calls another one of my functions, then the outer function has to also call this script first, and it is essential to call it with local=T:
source('readfun.R', local=T)
assuming of course that the script file is called readfun.R.
Is it possible to add an on.exit expr to the parent call? If so, how?
For example, say that parentOnExit(expr) is a function implementing this. Then for the following code:
f <- function() {
parentOnExit(print("B"))
print("A")
}
I want to see "A" printed, then "B".
Background: What brought this to mind was the following... we have a collection of functions, some of which call others, which require a resource that should be shared from the topmost call down and which also should be closed upon exiting the topmost function. Eg, a connection to a remote server which is expensive to open. One pattern for this is:
foo <- function(r=NULL) {
if (is.null(r)) { # If we weren't passed open connection, open one
r <- openR()
on.exit(close(r))
}
bar(r=r) # Pass the open connection down
}
I was hoping to abstract those three lines down to:
r <- openIfNull(r) # Magically call on.exit(close(r)) in scope of caller
Now that I think about it though, perhaps it's worth some repeated code to avoid anything too magical. But still I'm curious about the answer to my original question. Thank you!
I have seen in this recent mail discussion (https://stat.ethz.ch/pipermail/r-devel/2013-November/067874.html) that you can use do.call for this:
f <- function() { do.call("on.exit", list(quote(cat('ONEXIT!\n'))), envir = parent.frame()); 42 }
g <- function() { x <- f(); cat('Not yet!\n'); x }
g()
#Not yet!
#ONEXIT!
#[1] 42
Using this feature and an additional ugly trick to pass the R connection object to the caller environment, it seems to solve the problem:
openR <- function(id = "connection1") {
message('openR():', id)
list(id)
}
closeR <- function(r) {
message('closeR():', r[[1]])
}
openRIfNull <- function(r) {
if (length(r)) return(r)
# create the connection
r <- openR("openRIfNull")
# save it in the parent call environment
parent_env <- parent.frame()
assign("..openRIfNull_r_connection..", r, envir = parent_env)
do.call("on.exit", list(quote(closeR(..openRIfNull_r_connection..))), envir = parent_env)
r
}
foo <- function(r = NULL) {
message('entered foo()')
r <- openRIfNull(r)
bar(r = r) # Pass the open connection down
message('exited foo()')
}
bar <- function(r) {
message('bar()')
}
example use:
foo()
# entered foo()
# openR():openRIfNull
# bar()
# exited foo()
# closeR():openRIfNull
foo(openR('before'))
# entered foo()
# openR():before
# bar()
# exited foo()
I was intrigued by the problem and tried a couple of ways to solve it. Unfortunately, they didn't work. I'm therefore inclined to believe that it can't be done. ...But someone else might be able to prove me wrong!
Anyway, I though I'd post my failed attempts so that they are recorded. I made them so that they would print "ONEXIT!" after "Not yet!" if they worked...
1 - First, simply try to evaluate the on.exit in the parent environment:
f <- function() { eval(on.exit(cat('ONEXIT!\n')), parent.frame()); 42 }
g <- function() { x<-f(); cat('Not yet!\n'); x }
g() # Nope, doesn't work!
This doesn't work, probably because the on.exit function adds stuff to the current stack frame, not the current environment.
2 - Step up the game and try to return an expression that is evaluated by the caller:
f <- function() { quote( {on.exit(cat('ONEXIT!\n')); 42}) }
g <- function() { x<-eval(f()); cat('Not yet!\n'); x }
g() # Nope, doesn't work!
This doesn't work either, probably because eval has its own stack frame, different from g.
3 - Bring my A-game, and try to rely on lazy evaluation:
h <- function(x) sys.frame(sys.nframe())
f <- function() { h({cat('Registering\n');on.exit(cat("ONEXIT!\n"));42}) }
g <- function() { x<-f()$x; cat('Not yet!\n'); x }
g() # Worse, "ONEXIT!" is never printed...
This one returns an environment to the caller, and when the caller accesses "x" in it, the expression including on.exit is evaluated. ...But it seems on.exit does not register at all in this case.
4 - Hmm. There is one way that might still work: a .Call to some C code that calls on.exit. It might be that calling C won't add another stack frame... This is a bit too complex for me to test now, but maybe some RAPI/RCpp guru could give it a shot?
I remain confused, but if Tommy can't do it, I suspect I won't be able to either. This does the first task and since it seemed so simple I thought I must be missing something:
f <- function() {
on.exit(print("B"))
print("A")
}
Second effort:
txtB <- textConnection("test b")
txt <-textConnection("test A")
f <- function(con) { df <- read.table(con);
if( isOpen(txtB)){ print("B open")
eval( close(txtB), env=.GlobalEnv ) }
return(df) }
txtB #just to make sure it's still open
# description class mode text
# "\"test b\"" "textConnection" "r" "text"
# opened can read can write
# "opened" "yes" "no"
dat <- f(txt); dat
#[1] "B open"
# V1 V2
#1 test A
txtB
#Error in summary.connection(x) : invalid connection
(OK, I edited it to close a connection within the calling environment.)
So what am I missing? (It wasn't clear to me as I tested this that connections actually have environments.)
Though this question is quite old, there is a simple fix for any future visitors:
Use add=TRUE (I don't find the documentation very clear.)
f <- function() {
on.exit(expr = print("B"),
add = TRUE)
print("A")
}
A another solution is using withr::defer() which has more options and better documentation.
The vignette is especially helpful.