有两个功能访问单个功能的环境的正确方法？

Question

Based on the answer provided in 1088639 , 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, eg "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

Answer 1

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, ie 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)

Answer 2

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.

Answer 3

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.

Answer 4

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.