decorate a function to count the number of times it gets called while preserving the original functi-CodePudding

I want to write a decorator function that adds a counter to a function, counting the number of times it was called. E.g.

foo <- function(x) {x}
foo <- counter_decorator(foo)
foo(1)
foo(1)
# => the counter gets incremented with each call and has the value 2 now

The approach below basically works, but:

I want the inner function (which is returned by the decorator) to have the same formal args as the original function and not just ellipsis (i.e. ...). I am not sure how to accomplish that. Any ideas?
Not sure if the whole approach is a good one. Alternatives or improvements are appreciated.

Here is what I did so far:

# Init or reset counter
counter_init <- function() {
  .counters <<- list()  
}

# Decorate a function with a counter
#
# Each time the function is called the counter is incremented
#
# fun: function to be decorated
# fun_name: name in .counters list to store number of times in 
#
counter_decorator <- function(fun, fun_name = NULL) 
{
  # use function name if no name is passed explicitly
  if (is.null(fun_name)) {
    fun_name <- deparse(substitute(fun))  
  } 
  fun <- force(fun)   # deep copy to prevent infinite recursion
  function(...) {     # ==> ellipsis not optimal!
    n <- .counters[[fun_name]]
    if (is.null(n)) {
      n <- 0
    }
    .counters[[fun_name]] <<- n   1 
    fun(...)  
  }
}

Now let's create some functions and decorate them.

library(dplyr)    # for pipe

# Create functions and decorate them with a counter
   
# create and decorate in second call
add_one <- function(x) {
  x   1
} 
add_one <- counter_decorator(add_one)

# create and decorate the piping way by passing the fun_name arg
add_two <- {function(x) {
  x   2
}} %>% counter_decorator(fun_name = "add_two")

mean <- counter_decorator(mean)

counter_init()
for (i in 1:100) {
  add_one(1)
  add_two(1)
  mean(1)
}

What we get in the .counters list is

> .counters
$add_one
[1] 100

$add_two
[1] 100

$mean
[1] 100

which is basically what I want.

CodePudding user response：

The trace command can be used. Use untrace to undo the trace or set .counter to any desired value to start over again from that value.

f <- function(x) x
trace(f, quote(.counter <<- .counter   1), print = FALSE)

.counter <- 0
f(1)
## [1] 1
f(1)
## [1] 1
.counter
## [1] 2

Here is a variation that stores the counter in an attribute of f.

f <- function(x) x
trace(f, quote(attr(f, "counter") <<- attr(f, "counter")   1), print = FALSE)

attr(f, "counter") <- 0
f(1)
## [1] 1
f(1)
## [1] 1
attr(f, "counter")
## [1] 2

CodePudding user response：

This method stores the counter within the wrapper function itself instead of somewhere in the users environment or package environment. (There's nothing wrong with the latter; the former can be problematic or at least annoying/discourteous.)

The biggest side-effect (liability?) of this is when the package is detached or reloaded (i.e., during development), then the counter list is cleared/re-initialized.

counter_decorator <- function(fun) {
  .counter <- 0L
  fun2 <- function(...) {
    .counter <<- .counter   1L
    cl <- match.call()
    cl[[1]] <- fun
    eval.parent(cl)
  }
  formals(fun2) <- formals(args(fun))
  fun2
}

Demo:

foo <- function(x, y) x   y
foo2 <- counter_decorator(foo)
get(".counter", envir = environment(foo2))
# [1] 0
foo2(5, 9)
# [1] 14
foo2(5, 11)
# [1] 16
foo2(5, 13)
# [1] 18
get(".counter", envir = environment(foo2))
# [1] 3

Same formals:

formals(foo)
# $x
# $y
formals(foo2)
# $x
# $y

Edited (twice) to better track primitives where formals(.) is NULL; in that case, we can use formals(args(fun)).

Adapted for your preferred methodology, albeit with a little poetic liberty:

counters <- local({
  .counters <- list()
  function(init = FALSE) {
    out <- .counters # will return counters *before* initialization
    if (init) .counters <<- list()
    out
  }
})
counter_decorator <- function(fun, fun_name) {
  if (missing(fun_name)) {
    fun_name <- deparse(substitute(fun))
  }
  count <- get(".counters", envir = environment(counters))
  count[[fun_name]] <- 0L
  assign(".counters", count, envir = environment(counters))
  fun2 <- function(...) {
    .count <- get(".counters", envir = environment(counters))
    .count[[fun_name]] <- if (is.null(.count[[fun_name]])) 1L else .count[[fun_name]]   1L
    assign(".counters", .count, envir = environment(counters))
    cl <- match.call()
    cl[[1]] <- fun
    eval.parent(cl)
  }
  formals(fun2) <- formals(args(fun))
  fun2
}

add_one <- function(x) {
  x   1
}
add_one <- counter_decorator(add_one)
add_two <- {function(x) {
  x   2
}} %>% counter_decorator(fun_name = "add_two")
new_mean <- counter_decorator(mean)
for (i in 1:100) {
  add_one(1)
  add_two(1)
  new_mean(1)
}

counters()
# $add_one
# [1] 100
# $add_two
# [1] 100
# $mean
# [1] 100

formals(new_mean)
# $x
# $...

Initialization is not strictly required. Re-initialization returns the counters before reinitializing, so you don't need a double-call to get the values and then reset (and if you don't care about previous values, just ignore its return).

counters(TRUE)
# $add_one
# [1] 100
# $add_two
# [1] 100
# $mean
# [1] 100
counters()
# list()
add_one(10)
# [1] 11
counters()
# $add_one
# [1] 1