In R can I find the environment associated with a lazy argument? - r

Sorry this is a little complicated.
I want to capture an argument expression, but also know which environment it should be evaluated in. Something like this:
make.promise = function(x = print(b), b = 7) {
expr = substitute(x)
env = parent.frame()
function() {
eval(expr, env)
}
}
p1 = (
function() {
a = 2
make.promise(print(a))
}
)()
p2 = make.promise()
The problem is, if no argument is supplied for x, its environment becomes the local environment of make.promise(), and I don't know how to detect that. Is there a function other than substitute I could use that also captures the environment?

The simplest implementation of make.promise would be:
make.promise <- function(x) {
function() x
}
But I don't think that's what you're looking for. I'm not aware of any way to find the environment associated - you might try email the r-devel mailing list.

Related

How to return event$data in rstudio/websocket

I am trying to extend websocket::Websocket with a method that sends some data and returns the message, so that I can assign it to an object. My question is pretty much identical to https://community.rstudio.com/t/capture-streaming-json-over-websocket/16986. Unfortunately, the user there never revealed how they solved it themselves. My idea was to have the onMessage method return the event$data, i.e. something like:
my_websocket <- R6::R6Class("My websocket",
inherit = websocket::WebSocket,
public = list(
foo = function(x) {
msg <- super$send(paste("x"))
return(msg)
} )
)
load_websocket <- function(){
ws <- my_websocket$new("ws://foo.local")
ws$onMessage(function(event) {
return(event$data)
})
return(ws)
}
my_ws <- load_websocket()
my_ws$foo("hello") # returns NULL
but after spending a good hour on the Websocket source code, I am still completely in the dark as to where exactly the callback happens, "R environment wise".
You need to use super assignment operator <<-. <<- is most useful in conjunction with closures to maintain state. Unlike the usual single arrow assignment (<-) that always works on the current level, the double arrow operator can modify variables in parent levels.
my_websocket <- R6::R6Class("My websocket",
inherit = websocket::WebSocket,
public = list(
foo = function(x) {
msg <<- super$send(paste("x"))
return(msg)
} )
)
load_websocket <- function(){
ws <- my_websocket$new("ws://foo.local")
ws$onMessage(function(event) {
return(event$data)
})
return(ws)
}
my_ws <- load_websocket()
my_ws$foo("hello")

"demask" function by finding its definition from previously loaded package

In my package, I define %+% operator as a shortcut for strings concatenation. As it may be defined by previously loaded packages, I want to execute my custom code only when both arguments are suitable (e.g. character), otherwise try to call the code from previously loaded packages. Here is my solution for that:
# helper function to find environment of the package
getEnvByName <- function(inpEnv=.GlobalEnv, lookFor){
e <- inpEnv;
while (environmentName(e) != 'R_EmptyEnv' & environmentName(e)!=lookFor) e <- parent.env(e);
if (environmentName(e) != lookFor) return(NULL);
return(e);
}
"%+%" <- function(arg1, arg2){
if (is.character(arg1) & is.character(arg2)) {
paste0(arg1, arg2);
} else {
e <- parent.env(getEnvByName(.GlobalEnv,'package:mypackagename'));
if (exists('%+%', envir = e)) get('%+%',envir = e)(arg1,arg2);
}
}
My questions are:
1) is it a good way to treat such situations?
2) why it is not the common practice to do similar things in other packages? For example, in the ggplot2 package, %+% operator is defined as following:
"%+%" <- function (e1, e2)
{
e2name <- deparse(substitute(e2))
if (is.theme(e1)) add_theme(e1, e2, e2name)
else if (is.ggplot(e1)) add_ggplot(e1, e2, e2name)
}
as you see, their code breaks previously defined %+% for any arguments while they could just override it only for theme or ggplot arguments and keep all other cases. I could suggest the authors to implement this kind of check but I assume there's some reason they don't do it...
UPD. just a little modification of my code: instead of defining everything in one function, I split it with UseMethod() - I'm wondering if it makes any difference:
`%+%` <- function(...) UseMethod("%+%")
`%+%.character` <- paste0
`%+%.default` <- function (arg1, arg2){
e <- parent.env(getEnvByName(.GlobalEnv,'package:mypackagename'));
get('%+%',envir = e)(arg1,arg2);
}
First of all I don't think it is a good practice to reimplement functions that already exist in widely used package (I refer to previously mentioned %s+% from stringi).
As for about you question I think the best way is this:
'%+%' <- function(arg1, arg2){
if (is.character(arg1) & is.character(arg2)) {
paste0(arg1, arg2)
} else {
old.func <- get('%+%',
envir = parent.env(.GlobalEnv),
inherits = TRUE)
old.func(arg1, arg2)
}
}
With option inherits = TRUE (which is default by the way) get performs the same search in environments as is implemented in your answer;
The method with UseMethod will work differently because in that case %+% will check only the first argument for the type "character", not both arguments;
As for ggplot2s %+% I think it was intended to return NULL with not suitable arguments' type. It might possibly be a flaw in the code.

R: setting options within an environment

Is there a way to set options within an environment? Something like
tmp_env = new.env()
within(tmp_env, options(mc.core = 16))
with(tmp_env, {
# run parallel code here
})
I want to switch between using options(mc.core = 16) and options(mc.core = 1) explicitly and don't want to accidentally set off a parallelized computation.
Use a function or other closure (e.g., local()) to set the option, and use on.exit() to guarantee restoration on exit
fun = function() {
old.opt = options(mc.cores=12)
on.exit(options(old.opt))
## do work
}
You could get fancy with something like (based on with.default)
withp = function(expr, cores=4) {
old.opt = options(mc.cores=cores)
on.exit(options(old.opt))
eval(substitute(expr), enclos=parent.frame())
}
and use
withp({
message("hello")
res <- mclapply(1:20, function(i) Sys.getpid())
table(unlist(res))
}, cores=3)

Order of methods in R reference class and multiple files

There is one thing I really don't like about R reference class: the order you write the methods matters. Suppose your class goes like this:
myclass = setRefClass("myclass",
fields = list(
x = "numeric",
y = "numeric"
))
myclass$methods(
afunc = function(i) {
message("In afunc, I just call bfunc...")
bfunc(i)
}
)
myclass$methods(
bfunc = function(i) {
message("In bfunc, I just call cfunc...")
cfunc(i)
}
)
myclass$methods(
cfunc = function(i) {
message("In cfunc, I print out the sum of i, x and y...")
message(paste("i + x + y = ", i+x+y))
}
)
myclass$methods(
initialize = function(x, y) {
x <<- x
y <<- y
}
)
And then you start an instance, and call a method:
x = myclass(5, 6)
x$afunc(1)
You will get an error:
Error in x$afunc(1) : could not find function "bfunc"
I am interested in two things:
Is there a way to work around this nuisance?
Does this mean I can never split a really long class file into multiple files? (e.g. one file for each method.)
Calling bfunc(i) isn't going to invoke the method since it doesn't know what object it is operating on!
In your method definitions, .self is the object being methodded on (?). So change your code to:
myclass$methods(
afunc = function(i) {
message("In afunc, I just call bfunc...")
.self$bfunc(i)
}
)
(and similarly for bfunc). Are you coming from C++ or some language where functions within methods are automatically invoked within the object's context?
Some languages make this more explicit, for example in Python a method with one argument like yours actually has two arguments when defined, and would be:
def afunc(self, i):
[code]
but called like:
x.afunc(1)
then within the afunc there is the self variable which referes to x (although calling it self is a universal convention, it could be called anything).
In R, the .self is a little bit of magic sprinkled over reference classes. I don't think you could change it to .this even if you wanted.

Capture a function from parameter in NESTED function (closure function)

Consider a code snippet as follow:
f = function(y) function() y()
f(version)()
Error in f(version)() : could not find function "y"
P.s. It seems that the closure mechanism is quite different from C# Lambda. (?)
Q: How can I capture a function in the closure?
--EDIT--
Scenario: Actually, I would like to write a function factory, and I don't want to add parameter to the nested function.
Like this:
theme_factory = function(theme_fun)
{
function(device)
{
if (!is.onMac()) # Not Mac
{
(device == "RStudioGD") %?% theme_fun(): theme_fun(base_family="Heiti")
}
else
{
theme_fun(base_family="STHeiti")
}
}
}
And I defined two customized theme function for ggplot
theme_bw_rmd = theme_factory(theme_bw)
theme_grey_rmd = theme_factory(theme_grey)
Then I use them like:
function(device)
ggplot(data) + geom_point() something like that + theme_bw_rmd(device)
Thanks.
So the problem is with passing parameter? What about something like this:
alwaysaddone <- function(f) function(...) f(...)+1
biggersum <- alwaysaddone(sum)
sum(1:3)
# 6
biggersum(1:3)
# 7
You can use ... to "pass-through" any parameters you like.
Use eval(func, envir = list(... captured parameters)) or substitute(func, envir) to eval the captured function in a specific environment.

Resources