Give the two functions
subfun <- function(txt)
gsubfn::gsubfn("§([^§]+)§", ~eval(parse(text=x)), txt)
topfun <- function(id = 1L)
subfun("Hello §id§ world!")
The following (1.) should yield "Hello 1 world!"but throws an error instead:
topfun()
# Error in eval(expr, envir, enclos) : object 'id' not found
These two (2.) & (3.) work as expected:
id <- 2L
topfun()
# [1] "Hello 2 world!"
topfun2 <- function(id = 1L)
gsubfn::gsubfn("§([^§]+)§", ~eval(parse(text=x)), "Hello §id§ world!")
topfun2()
# [1] "Hello 1 world!"
How can I make (1.) work?
I tried several environment() and parent.frame() variations with the envir parameter of eval and gsubfn, including passing topfun's environment to subfun via the ellipsis argument. All to no success. (Not that I had greater knowledge of what's going on under the hood. But I would have expected R to go up one parent environment after another to look for id...)
I'm using R version 3.3.0 and gsubfn package version 0.6.6.
Thanks in advance!
I am no expert at this but the problem seems to be the use of a formula as replacement in gsubfun. At least I am unable to pass an environment to eval if it is in a formula.
subfun_2 <- function(txt){
ev <- parent.frame() # the environment in which subfun_2 was called
gsubfn::gsubfn("§([^§]+)§", ~eval(parse(text=x), envir = ev), txt)
}
topfun_2 <- function(id = 1L) subfun_2("Hello §id§ world!")
topfun_2()
# Error in eval(parse(text = x), envir = ev) :
# argument "ev" is missing, with no default
If you use a function instead it works as expected:
subfun_3 <- function(txt){
ev <- parent.frame()
gsubfn::gsubfn("§([^§]+)§", function(x)eval(parse(text=x), envir = ev), txt)
}
topfun_3 <- function(id = 1L) subfun_3("Hello §id§ world!")
topfun_3()
# Hello 1 world!
Related
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.
It's complicated to explain my use case but I am working on a project that requires parsing text that may throw some errors. I would like to use tryCatch() so that as much of the script can run as possible and alert the user that some code failed. I can use a loop for this but I would like to know why this behaviour exists and if there is an apply function that does do the trick.
When I run the loop or use do.call() on this parsed object, I get just the expected single error mesage. When I use lapply() I get the same error message followed by the ouput of the assignments. I've tried throwing suppress functions around lapply() which, perhaps obviously, did not work. and I get similar output for sapply() and map(). Curious if someone can explain it to me.
test_text <- parse(text = "x <- pi; y <- x; z <- stop()")
eval_try <- function(x) {
tryCatch(
eval(x, envir = .GlobalEnv),
error = function(cond) message("there was an error"),
warning = function(cond) message("there was a warning")
)
}
for (i in seq_along(test_text)) {
eval_try(test_text[i])
}
#> there was an error
do.call("eval_try", list(test_text))
#> there was an error
lapply(test_text, eval_try)
# there was an error
# [[1]]
# [1] 3.141593
#
# [[2]]
# [1] 3.141593
#
# [[3]]
# NULL
The printing you see is the output of the lapply function. You can suppress it by assigning the result to a variable or if you really don't care about storing the output, use the below trick with invisible.
> myfun <- function(x) x
>
> lapply(1:3, FUN = myfun)
[[1]]
[1] 1
[[2]]
[1] 2
[[3]]
[1] 3
> a <- lapply(1:3, FUN = myfun)
> invisible(lapply(1:3, FUN = myfun))
I know about methods(), which returns all methods for a given class. Suppose I have x and I want to know what method will be called when I call foo(x). Is there a oneliner or package that will do this?
The shortest I can think of is:
sapply(class(x), function(y) try(getS3method('foo', y), silent = TRUE))
and then to check the class of the results... but is there not a builtin for this?
Update
The full one liner would be:
fm <- function (x, method) {
cls <- c(class(x), 'default')
results <- lapply(cls, function(y) try(getS3method(method, y), silent = TRUE))
Find(function (x) class(x) != 'try-error', results)
}
This will work with most things but be aware that it might fail with some complex objects. For example, according to ?S3Methods, calling foo on matrix(1:4, 2, 2) would try foo.matrix, then foo.numeric, then foo.default; whereas this code will just look for foo.matrix and foo.default.
findMethod defined below is not a one-liner but its body has only 4 lines of code (and if we required that the generic be passed as a character string it could be reduced to 3 lines of code). It will return a character string representing the name of the method that would be dispatched by the input generic given that generic and its arguments. (Replace the last line of the body of findMethod with get(X(...)) if you want to return the method itself instead.) Internally it creates a generic X and an X method corresponding to each method of the input generic such that each X method returns the name of the method of the input generic that would be run. The X generic and its methods are all created within the findMethod function so they disappear when findMethod exits. To get the result we just run X with the input argument(s) as the final line of the findMethod function body.
findMethod <- function(generic, ...) {
ch <- deparse(substitute(generic))
f <- X <- function(x, ...) UseMethod("X")
for(m in methods(ch)) assign(sub(ch, "X", m, fixed = TRUE), "body<-"(f, value = m))
X(...)
}
Now test it. (Note that the one-liner in the question fails with an error in several of these tests but findMethod gives the expected result.)
findMethod(as.ts, iris)
## [1] "as.ts.default"
findMethod(print, iris)
## [1] "print.data.frame"
findMethod(print, Sys.time())
## [1] "print.POSIXct"
findMethod(print, 22)
## [1] "print.default"
# in this example it looks at 2nd component of class vector as no print.ordered exists
class(ordered(3))
## [1] "ordered" "factor"
findMethod(print, ordered(3))
## [1] "print.factor"
findMethod(`[`, BOD, 1:2, "Time")
## [1] "[.data.frame"
I use this:
s3_method <- function(generic, class, env = parent.frame()) {
fn <- get(generic, envir = env)
ns <- asNamespace(topenv(fn))
tbl <- ns$.__S3MethodsTable__.
for (c in class) {
name <- paste0(generic, ".", c)
if (exists(name, envir = tbl, inherits = FALSE)) {
return(get(name, envir = tbl))
}
if (exists(name, envir = globalenv(), inherits = FALSE)) {
return(get(name, envir = globalenv()))
}
}
NULL
}
For simplicity this doesn't return methods defined by assignment in the calling environment. The global environment is checked for convenience during development. These are the same rules used in r-lib packages.
I'm trying to write a function 'exported' in R that will assign a value to a name in a desired environment (say .GlobalEnv). I'd like to use the following syntax.
# desired semantics: x <- 60
exported(x) <- 60
# ok if quotes prove necessary.
exported("x") <- 60
I've tried several variations. Most basically:
`export<-` <- function(x, obj) {
call <- as.list(match.call())
elem <- as.character(call[[2]])
assign(elem, obj, .GlobalEnv)
get(elem, .GlobalEnv)
}
exported(x) <- 50
The foregoing gives an error about the last argument being unused. The following complains that "object 'x' is not found."
setGeneric("exported<-", function(object, ...) {
standardGeneric("exported<-")
})
setReplaceMethod("exported", "ANY", function(object, func) {
call <- as.list(match.call())
name <- as.character(call$object)
assign(name, func, other.env)
assign(name, func, .GlobalEnv)
get(name, .GlobalEnv)
})
exported(x) <- 50
The above approach using a character vector in place of a name yields "target of assignment expands to non-language object."
Is this possible in R?
EDIT: I would actually like to do more work inside 'exported.' Code was omitted for brevity. I also realize I can use do something like:
exported(name, func) {
...
}
but am interested in seeing if my syntax is possible.
I can't understand why you wouldn't use assign?
assign( "x" , 60 , env = .GlobalEnv )
x
[1] 60
The env argument specifies the environment into which to assign the variable.
e <- new.env()
assign( "y" , 50 , env = e )
ls( env = e )
[1] "y"
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.