Function to assign a value in a new environment in R - r

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"

Related

How to assign function defaults to R .GlobalEnv

For some debugging purpose i often need to have function default values in the global environment.
f<-function(a=1,b=T,c) {}
formals(f) returns a pairlist with a "symbol" type values. So, i cannot just attach(as.list(formals(f)))...
Try this:
ff <- f
body(ff) <- quote(environment())
Now this will put them in the global environment:
list2env(as.list(ff()), .GlobalEnv)
or this will attach them to the search path:
attach(ff())
Note 1
a and b are normal variables but c is represented by a missing value so although it will be in the global environment or search path you can't print it; however, you can query whether or not it is such a variable like this:
inherits(try(c, silent = TRUE), "try-error")
## [1] TRUE
That expression will be FALSE for variables having a value.
Note 2
To only copy only the arguments having defaults to the global environment:
ff <- f
body(ff) <- quote({
L <- as.list(environment())
is_missing <- sapply(names(L), function(x) {
x <- as.list(ff)[[x]]
missing(x)
})
L[! is_missing]
})
list2env(ff(), .GlobalEnv)
or to attach them replace the last line with:
attach(ff())

R get object from global environment from function if object exists in global but use different default if not

Surely this is possible, but I can't seem to find how to do it:
I'd like to have a default of a function input, but override the default and get() a variable from the global environment if it exists in the global environment. If it doesn't exist in the global environment, take the default of the function, with any setting in the function being top level and overriding them all.
Ideally it would work like this made-up non-working function:
###Does not work, desired example
myfunc <- function(x=30){
if(exists.in.global.env(x)){x <- get(x)}
###Top level is tough
if(x.is.defined.as.function.input=TRUE ????){x <- x.defined.as.input}
}else{ x <- 30}
return(x)
}
So that if I do:
myfunc()
[1] 30
But if I create x I want it to override the default x=30 of the function and take the global environment value instead:
x <- 100
myfunc()
[1] 100
But if I have x defined inside the function, I'd like that to be top level, i.e. override everything else even if x is defined globally:
x <- 100
myfunc(x=300)
[1] 300
Thanks in advance!
You can modify your function to check if x exists in the .GlobalEnv and get it from there if it does, otherwise return the default value.
myfunc <- function(x = 30) {
if ("x" %in% ls(envir = .GlobalEnv)) {
get("x", envir = .GlobalEnv)
} else {
x
}
}
So if "x" %in% ls(envir = .GlobalEnv) is FALSE it would return
myfunc()
[1] 30
If x is found it would return it. if x <- 100:
myfunc()
[1] 100
Edit after comment
If you want to make sure to only return x from the global environment if x is not specified as an argument to myfunc, you can use missing(). It returns TRUE if x was not passed and FALSE if it was:
myfunc <- function(x = 30) {
if ("x" %in% ls(envir = .GlobalEnv) & missing(x)) {
get("x", envir = .GlobalEnv)
} else {
x
}
}
So for your example:
x <- 100
myfunc(x=300)
[1] 300
The simplest method would be to set an appropriate default argument:
myfunc <- function(x=get("x", globalenv())
{
x
}
> x <- 100
> f()
[1] 100
> f(30)
[1] 30
> rm(x)
> f()
Error in get("x", globalenv()) : object 'x' not found

How does the envir option of do.call work?

The documentation of do.call states:
If quote is FALSE, the default, then the arguments are evaluated (in the calling environment, not in envir).
This sentence would suggest to me that when quote = FALSE, specifying envir makes no difference. However, that's not the case, and in fact I've encountered cases where I need to specify envir to get the function to work.
Simplest reproducible example:
g1 <- function(x) {
args <- as.list(match.call())
args[[1]] <- NULL # remove the function call
do.call(print, args, quote = FALSE) # call print()
}
g2 <- function(x) {
args <- as.list(match.call())
args[[1]] <- NULL # remove the function call
do.call(print, args, quote = FALSE, envir = parent.frame()) # call print(), specifying envir
}
h1 <- function(x, y) {
g1(x*y)
}
h2 <- function(x, y) {
g2(x*y)
}
With these functions, h2() behaves as one would think but h1() does not:
h1(2, 3)
#Error in print(x) : object 'y' not found
h2(2, 3)
#[1] 6
y <- 100
h1(2, 3)
#[1] 600
## Looks like g1() took the value of y from the global environment
h2(2, 3)
#[1] 6
Can anybody explain to me what's going on here?
Note: There's a related post here but by my reading the answers don't specifically state what do.call() does with the envir variable.
?do.call says:
envir
an environment within which to evaluate the call. This will be
most useful if what is a character string and the arguments are
symbols or quoted expressions.
We can easily illustrate this if the what= argument of do.call is a character string. Then envir= determines where it is looked up.
e <- new.env()
e$f <- function() 2
f <- function() 3
do.call("f", list())
## [1] 3
do.call("f", list(), envir = e)
## [1] 2
The same is true for the arguments as the code in the question shows. Note that the arguments are already quoted since match.call() is being used.
What is happening in the case of h1 and g1 is that this is effectively run within g1
do.call(print, list(call("*", quote(x), quote(y))), quote = FALSE)
Now it finds x in g1 (since g1 has one argument x) but there is no y in g1 so it looks to the parent environment of g1 which is the global environment where it finds y.
In the case of h2 and g2 it runs this in g2:
do.call(print, list(call("*", quote(x), quote(y))), quote = FALSE, envir = parent.frame())
and it finds x and y in h2 which is the parentframe of g2.
Note that the parent environment is not the same as the parent frame:
the parent environment is determined by where the function was defined so if the function was defined in the global environment then its parent environment is the global environment.
the parent frame is the environment of the caller

R: how to find what S3 method will be called on an object?

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.

How to use the get() function? Making higher hierarchy object accessible as local variable

I have some code below. Now I would want to manipulate my initial top level x variable when an error occurs in the tryCatch statement. I read the documentation, but I can't really figure out how it's supposed to be used.
Some questions I can't get my head around.
What is the workflow for these type of issues? (Should I define a new enviroment for the x variable and reference that enrivoment when I want x in my local function?
How to use the get() function? I suppose for my task I need the get() function, coupled with the superassignment operator <<- or assign.
Something like. x <<- x[! x %in% get(x, envir = "no idea")] is what I need.
You can try out the code by specifying any vector with valid yahoo tickers, such as LoadData(c('YHOO', 'GOOG')). The tryCatch statement is meant to catch any tickers that do not exist, and in that case I want to modify my initial ticker list (the x variable) to not include this ticker name. Thus the need for an get() operation.
LoadData <- function(x) {
if(is.atomic(x) != TRUE & is.data.frame(x) != TRUE) stop('x must be either a data.frame or an atomic object')
if(is.data.frame(x) == TRUE) x <- as.character(x[,1])
df.list <- lapply(x, function(x) {
poss.error <- tryCatch(
{
quantmod::getSymbols(x, env = NULL, return.class = 'data.frame')
},
error = function(e) {
message(cat(x, "could not be retrieved"))
# Get the x variable that was passed to LoadData() and manipulate it.
return(e)
})
}
In the function call LoadData(c('YHOO', 'GOOG')) mentioned in your question, the argument x is not a variable but simply a value. If the value is first stored in a variable, e.g. v, then the value of this variable can be altered by the function. (v is the "global" name outside the function, x is the name inside the function.)
Now consider the function call LoadData(x=v) or simply LoadData(v). To get the variable v from inside the function, two things are needed:
The environment env in which the variable v is stored,
The name under which the variable v is stored in the environment env.
The environment env should be another argument of the function LoadData, perhaps with the global environment as default value:
LoadData <- function(x,env=.GlobalEnv) { ... }
The trick to get the name of the variable passed to the argument x is to use the function match.call. as.list(match.call()) is a named list and as.list(match.call())$x is the "symbol" that is passed to the argument x, i.e. "v" in our case. Then
x.name <- as.character(as.list(match.call())$x`)
is the desired name of the variable passed to the argument x.
Now you can use env[[x.name]] to alter the value of v. The value of v is get(x.name,env), but this is the same as the value of x. So get is not really needed.
Here is a small example:
f <- function( x, v, env=.GlobalEnv )
{
x.name <- as.character(as.list(match.call())$x)
if ( !is.numeric(x) ) { stop(paste0(x.name," must be numeric")) }
env[[x.name]] <- x-v
return(NULL)
}
.
> x <- 5
> y <- 3
> z <- "abc"
> f(x,1)
NULL
> x
[1] 4
> f(y,2)
NULL
> y
[1] 1
> f(z,3)
Error in f(z, 3) : z must be numeric
>
If f is called from another function g to alter the value of a local variable a, the argument env has to be used:
g <- function()
{
a <- 10
print("global environment:")
print(ls(.GlobalEnv))
print("local environment:")
print(ls(environment()))
print("value of `a` before calling `f`:")
print(a)
f(a,1,environment())
print("value of `a` after calling `f`:")
print(a)
return(NULL)
}
.
> g()
[1] "global environment:"
[1] "f" "g" "x" "y" "z"
[1] "local environment:"
[1] "a"
[1] "value of `a` before calling `f`:"
[1] 10
[1] "value of `a` after calling `f`:"
[1] 9
NULL
If the variable passed to LoadData is always the same variable and stored in the global environment, LoadData doesn't need any argument. Then you can simply use <<-.

Resources