decorate a function to count the number of times it gets called while preserving the original functions args

Question

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.

Answer 1

1) 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

2) This variation 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

3) This variation stores the counter in an option.

f <- function(x) x
trace(f, quote(options(counter = getOption("counter", 0) + 1)), print = FALSE)

f(1)
## [1] 1
f(1)
## [1] 1
getOption("counter")
## [1] 2