装饰一个函数以计算它被调用的次数，同时保留原始函数参数

Question

我想编写一个装饰器函数，为函数添加一个计数器，计算它被调用的次数。例如

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

下面的方法基本上有效，但是：

• 我希望内部函数（由装饰器返回）具有与原始函数相同的形式参数，而不仅仅是省略号（即...）。我不知道如何做到这一点。有任何想法吗？
• 不确定整个方法是否好。替代方案或改进值得赞赏。

这是我到目前为止所做的：

# 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(...)  
  }
}

现在让我们创建一些函数并装饰它们。

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

我们在列表中得到的.counters是

> .counters
$add_one
[1] 100

$add_two
[1] 100

$mean
[1] 100

这基本上就是我想要的。

Answer 1

1）可以使用trace命令。使用 untrace 撤消跟踪或将 .counter 设置为任何所需值以从该值重新开始。

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)该变体将计数器存储在 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)此变体将计数器存储在选项中。

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