Maybe I am thinking of R classes as if they were classes in C or Java, but I cannot seem to modify values:
test <- function() {
inc <- function() {
x <- attr( obj, "x" )
x <- x + 1
print(x)
attr( obj, "x" ) <- x
return( obj )
}
obj <- list(inc=inc)
attr( obj, "x" ) <- 1
class(obj) <- c('test')
return( obj )
}
When I run this:
> t <- test()
> t <- t$inc()
[1] 2
> t <- t$inc()
[1] 2
It is as if the original class object cannot be modified.
One can use the lexical scoping mechanism of R to achieve a C or Java like object orientation.
Use <<- to assign a value in the parent environment.
A simplified version of your examples is below.
test <- function() {
inc <- function() {
x <<- x + 1
print(x)
}
x <- 1
list(inc=inc)
}
obj <- test()
obj$inc()
[1] 2
obj$inc()
[1] 3
See also ?refClass-class for what is called "reference classes" in R.
Related
I have the following requirement: I have a list of variables and functions defined in a config.R file:
# config.R
x <- 1
foo <- function(y) {
2
}
z <- x + 1
I want the above to be "sourced" in a list defined in the .Globalenv
I have a way to do this by creating a local environment:
source_in_list <- function(path) {
e <- new.env()
source(path, local = e)
return(as.list(e))
}
p <- source_in_list("config.R")
p
$x
[1] 1
$z
[1] 2
$foo
function(y) {
2
}
<environment: 0x2f99d90>
My problem is that foo is linked to the <environment: 0x2f99d90>, which means if I was to redefine foo in the .Globalenv p$foo would be unaffected, and this is not what I want.
Essentially, I would like to do as if I was:
creating p in .Globalenv
executing every line within p
so result would be like:
p
$x
[1] 1
$z
[1] 2
$foo
function(y) {
2
}
How can I do this ?
EDIT:
I realized that what I wanted was define functions from the source file in the globalenv() and the rest in a list
source_in_list <- function(path) {
e <- new.env()
source(path, local = e)
# types
is_fun <- sapply(e, FUN = function(x) inherits(x, "function"))
# define functions from e into globalenv
if(any(is_fun)) {
for(fun_name in names(which(is_fun))) {
# assign in globalenv
assign(x = fun_name, value = eval(parse(text = deparse(get(fun_name, envir = e))), envir = globalenv()), envir = globalenv())
# remove from local env
rm(list = fun_name, envir = e)
}
}
return(as.list(e))
}
p1 <- source_in_list("config.R")
p1
$x
[1] 1
$z
[1] 2
foo
function (y)
{
2
}
>
I think you have a misconception: if foo is stored in your list p, then redefining foo in .Globalenv won't have any effect. Those will be separate objects.
The purpose of the environment associated with a function is to tell R where to look for non-local variables used in the function. Your original version will end up with two copies of everything you sourced, one in the list and one in the local environment you created. If foo referred to x, it would see the one in the local environment. For example, look at this change to your code where foo() returns x:
# config.R
x <- 1
foo <- function() {
x
}
z <- x + 1
and then
source_in_list <- function(path) {
e <- new.env()
source(path, local = e)
return(as.list(e))
}
p <- source_in_list("config.R")
x <- 42 # Set a global variable x
p$foo()
# [1] 1 # It is ignored
p$x <- 123 # Set x in p
p$foo()
# [1] 1 # It is ignored
You probably don't want two copies of everything. But then it's not clear that what you want to do is possible. A list can't act as the environment of a function, so there's no way to make p$x be the target of references from within foo.
I'd suggest that instead of returning a list, you just return the local environment you created. Then things will work as you'd expect:
source_to_local <- function(path) {
e <- new.env()
source(path, local = e)
return(e)
}
e <- source_to_local("config.R")
x <- 42 # set a global
e$foo()
[1] 1 # it is ignored
e$x <- 123 # set x in e
e$foo()
[1] 123 # it responds
The main disadvantage of returning the environment is that they don't print the way lists do, but you could probably write a function to print an environment and make everything in it visible.
I want to override the behavior of the dollar operator, so that if I have
x <- new.env()
x$foo <- 3
will e.g. call something. I tried to look for possible functions such as $, but my knowledge of the internals is not good enough.
I tried this:
`$` <- function(a, b) {
res <- .Primitive("$")(a, b);
print(res);
if(is.null(res)) { print("null!") };
return(res)
}
It kind of seem to work, but:
> x$foobar
NULL
[1] "null!"
NULL
> x$foobar <- 3
> x$foobar
NULL
[1] "null!"
NULL
>
So it seems to stay null despite the override.
Normal behavior of R's environments:
myenv <- new.env(parent = emptyenv())
myenv$foo <- 3
class(myenv)
# [1] "environment"
myenv$foo
# [1] 3
myenv$foobar
# NULL
Let's define a super-class (I'll name it environment2, feel free to be creative here) and override $ for that class:
class(myenv) <- c("environment2", "environment")
`$.environment2` <- function(x, name) {
stopifnot(name %in% names(x))
NextMethod()
}
myenv$foo
# [1] 3
myenv$foobar
# Error in `$.environment2`(myenv, foobar) : name %in% names(x) is not TRUE
You can easily clean up that error if you'd like, either using an if statement with stop, or (in R-4 or newer) naming the conditions in stopifnot.
`$.environment2` <- function(x, name) {
if (!name %in% names(x)) stop("something meaningful", call. = FALSE)
NextMethod()
}
`$.environment2` <- function(x, name) {
stopifnot(
"something meaningful" = name %in% names(x)
)
NextMethod()
}
### both render
myenv$foobar
# Error in `$.environment2`(myenv, foobar) : something meaningful
They are relatively equivalent, but with if/stop, you can reduce the error context:
`$.environment2` <- function(x, name) {
if (!name %in% names(x)) stop("something meaningful", call. = FALSE)
NextMethod()
}
myenv$foobar
# Error: something meaningful
The function would look something like:
function(input, FUN, output) {
output <- FUN(input)
return(input)
}
Where output is an unquoted name of an object to be created.
Let's skip the part where this is probably a bad idea: is this sort of thing possible? How would you go about doing it?
Clean code would just return it.
But you have other options:
the <<- operator
the assign() function where you can list the environment to assign to
Here is a trivial example:
R> foo <- function(x=21) { y <<- 2*x; return(3*x) }
R> foo(10)
[1] 30
R> y
[1] 20
R>
1) Try this:
fun <- function(input, FUN, output = "output", envir = parent.frame()) {
envir[[output]] <- FUN(input)
input
}
fun(4, sqrt)
## [1] 4
output
## [1] 2
Note that if hardcoding the output variable name to output is ok then the assignment could be written:
envir$output <- FUN(input)
2) Another possibility if you want to output both the input and output yet avoiding side effects is to return both in a list:
fun2 <- function(input, FUN, output = "output")
setNames(list(input, FUN(input)), c("input", output))
fun2(4, sqrt)
giving:
$input
[1] 4
$output
[1] 2
2a) A variation of this is:
devtools::install_github("ggrothendieck/gsubfn")
library(gsubfn) # list[...] <- ...
list[input, output] <- fun2(sqrt)
giving:
> input
[1] 4
> output
[1] 2
3) Yet another possibility is to pass the input in an attribute:
fun3 <- function(input, FUN) {
out <- FUN(input)
attr(out, "input") <- input
out
}
fun3(4, sqrt)
giving:
[1] 2
attr(,"input")
[1] 4
Based on the answer provided in1088639, I set up a pair of functions which both access the same sub-function's environment. This example works, but I wanted to see if I'd missed some cleaner way to "connect" both top-level functions to the internal environment.
( Back story: I wanted to write a pair of complementary functions which shared a variable, e.g. "count" in this example, and meet CRAN package requirements which do not allow functions to modify the global environment. )
static.f <- function() {
count <- 0
f <- function(x) {
count <<- count + 1
return( list(mean=mean(x), count=count) )
}
return( f )
}
# make sure not to delete this command, even tho' it's not
# creating a function.
f1 <- static.f()
statfoo <- function(x){
tmp<-f1(x)
tmp<- list(tmp,plus=2)
return(tmp)
}
statbar <- function(x){
tmp<-f1(x)
tmp<- list(tmp,minus=3)
return(tmp)
}
Sample output:
> statfoo(5)
[[1]]
[[1]]$mean
[1] 5
[[1]]$count
[1] 1
$plus
[1] 2
Rgames> statfoo(5)
[[1]]
[[1]]$mean
[1] 5
[[1]]$count
[1] 2
$plus
[1] 2
> statbar(4)
[[1]]
[[1]]$mean
[1] 4
[[1]]$count
[1] 3
$minus
[1] 3
> statfoo(5)
[[1]]
[[1]]$mean
[1] 5
[[1]]$count
[1] 4
$plus
[1] 2
A cleaner method would be to use an object oriented approach. There is already an answer using reference classes.
A typical object oriented approach with classes would create a class and then create a singleton object, i.e. a single object of that class. Of course it is a bit wasteful to create a class only to create one object from it so here we provide a proto example. (Creating a function to enclose count and the function doing the real work has a similar problem -- you create an enclosing function only to run it once.) The proto model allows one to create an object directly bypassing the need to create a class only to use it once. Here foobar is the proto object with property count and methods stats, statfoo and statbar. Note that we factored out stats to avoid duplicating its code in each of statfoo and statbar. (continued further down)
library(proto)
foobar <- proto(count = 0,
stats = function(., x) {
.$count <- .$count + 1
list(mean = mean(x), count = .$count)
},
statfoo = function(., x) c(.$stats(x), plus = 2),
statbar = function(., x) c(.$stats(x), plus = 3)
)
foobar$statfoo(1:3)
foobar$statbar(2:4)
giving:
> foobar$statfoo(1:3)
$mean
[1] 2
$count
[1] 1
$plus
[1] 2
> foobar$statbar(2:4)
$mean
[1] 3
$count
[1] 2
$plus
[1] 3
A second design would be to have statfoo and statbar as independent functions and only keep count and stats in foobar (continued further down)
library(proto)
foobar <- proto(count = 0,
stats = function(., x) {
.$count <- .$count + 1
list(mean = mean(x), count = .$count)
}
)
statfoo <- function(x) c(foobar$stats(x), plus = 2)
statbar <- function(x) c(foobar$stats(x), plus = 3)
statfoo(1:3)
statbar(2:4)
giving similar output to the prior example.
Third approach Of course the second variation could easily be implemented by using local and a function getting us close to where you started. This does not use any packages but does not create a function only to throw it away:
foobar <- local({
count <- 0
function(x) {
count <<- count + 1
list(mean = mean(x), count = count)
}
})
statfoo <- function(x) c(foobar(x), plus = 2)
statbar <- function(x) c(foobar(x), plus = 3)
statfoo(1:3)
statbar(2:4)
Another simple option is tocreate an environment and assign it to both functions. Here I use simpler functions for illustrative purposes, but this can be easily extended:
f1 <- function() {count <<- count + 1; return(paste("hello", count))}
f2 <- function() {count <<- count + 1; return(paste("goodbye", count))}
environment(f1) <- environment(f2) <- list2env(list(count=0))
Then:
> f1()
[1] "hello 1"
> f2()
[1] "goodbye 2"
> f1()
[1] "hello 3"
Both functions have the same environment.
You can use reference class like this:
foobar <- setRefClass(
'foobar',
fields = list(count='numeric'),
methods = list(
initialize=function() {
.self$initFields(count = 0L)
},
statfoo = function(x) {
count <<- count + 1L
list(list(mean=mean(x), count=count), plus=2)
},
statbar = function(x){
count <<- count + 1L
list(list(mean=mean(x), count=count), minus=3)
}
)
)()
foobar$statfoo(5)
foobar$statbar(3)
It makes it relatively clear that neither statfoo nor statbar is a pure function.
You could get rid of the factory functions, and more explicitly use environments. A solution like this would work as well
.env<-(function() {
count <- 0
f <- function(x) {
count <<- count + 1
return( list(mean=mean(x), count=count))
}
return(environment())
})()
statfoo <- function(x){
list(.env$f(x),plus=2)
}
statbar <- function(x){
list(.env$f(x),minus=3)
}
The .env variable is created by immediately executing an anonymous function to get its environment. We then extract the function from the environment itself to modify its values.
I have written a stack "class" with the following functions: add, push, pop, size, isEmpty, clear (and some more).
I'd like to use this "class" as a generic in R, so I may create multiple instances of stacks within my script. How do I go about doing this?
(I have class in quotes because my stack functions are written in a different script (not necessarily the definition of a class per se)
Thanks in advance
list <- ""
cursor = 0
#Initializes stack to empty
stack <- function(){
list <- c()
cursor = -1
assign("list",list,.GlobalEnv)
assign("cursor",cursor,.GlobalEnv)
}
#Where item is a item to be added to generic list
push <- function(item){
if(size(list) == 0){
add(item, -1)
}else{
add(item, 0)
}
assign("list",list,.GlobalEnv)
}
This is a simpler version of the stack implementation #GSee references that avoids using any of the formal object-orientation systems available in R. Simplification proceeds from the fact that all functions in R are closures and functions created during a function call are bound to the environment created for that call.
new_stack <- function() {
stack <- vector()
push <- function(x) stack <<- c(stack, x)
pop <- function() {
tmp<-tail(stack, 1)
stack<<-stack[-length(stack)]
return(tmp)
}
structure(list(pop=pop, push=push), class='stack')
}
x <- new_stack()
x$push(1:3)
x$pop()
# [1] 3
x$pop()
# [1] 2
Here's an S4 implementation, for comparison.
setClass('Stack',
representation(list='list', cursor='numeric'), # type defs
prototype(list=list(), cursor=NA_real_)) # default values
setGeneric('push', function(obj, ...) standardGeneric('push'))
setMethod('push', signature(obj='Stack'),
function(obj, x) {
obj#list <- c(x, obj#list)
obj
})
setGeneric('pop', function(obj, ...) standardGeneric('pop'))
setMethod('pop', signature(obj='Stack'),
function(obj) {
obj#cursor <- obj#list[[1]]
obj#list <- obj#list[-1]
obj
}
)
x <- new('Stack')
# cursor is empty to start
x#cursor
#[1] NA
# add items
x <- push(x, 1)
x <- push(x, 2)
# pop them (move next item to cursor, remove from list)
x <- pop(x)
x#cursor
# [1] 2
x <- pop(x)
x#cursor
# [1] 1
Since you are specifically talking about a stack "class" with push and pop methods, here's an implementation by Jeff Ryan taken from Introducing Closures which you can read for an explanation of what's going on here.
new_stack <- function() {
stack <- new.env()
stack$.Data <- vector()
stack$push <- function(x) .Data <<- c(.Data,x)
stack$pop <- function() {
tmp <- .Data[length(.Data)]
.Data <<- .Data[-length(.Data)]
return(tmp)
}
environment(stack$push) <- as.environment(stack)
environment(stack$pop) <- as.environment(stack)
class(stack) <- "stack"
stack
}
> x <- new_stack()
> x$push(1:3)
> x$pop()
[1] 3
> x$pop()
[1] 2
Then, if you create S3 generics...
push <- function(x, value, ...) UseMethod("push")
pop <- function(x, ...) UseMethod("pop")
push.stack <- function(x, value, ...) x$push(value)
pop.stack <- function(x) x$pop()
> push(x, 5)
> pop(x)
[1] 5
> pop(x)
[1] 1