Closures in R like Python

Question

First consider the following Python code that count how many times a function was called:

def counter(fn):
    count = 0
    def inner(*args, **kwargs):
        nonlocal count
        count +=1
        print('Function {0} was called {1} times'.format(fn.__name__, count))
        return fn(*args, **kwargs)
    return inner

def add(a,b):
    return a+b
def mult(a,b):
    return a*b
add = counter(add)
mult = counter(mult)
add(1,2)
add(2,3)
mult(1,5)
#output
Function add was called 1 times
Function add was called 2 times
Function mult was called 1 times

Now I am trying to do the same method in R as follows:

counter <- function(fn) {
  cnt <- 0
  inner <- function(...) {
    cnt <<- cnt + 1
    print(paste("Function", match.call(), "was called", cnt, "times\n"))
    return(fn(...))
  }
  return(inner)
  
}
add <- function(a, b) a + b
mult <- function(a, b) a*b
cnt_add <- counter(add)
cnt_add(1, 4) 
cnt_add(3, 9)
[1] "Function cnt_add was called 1 times\n"
[2] "Function 1 was called 1 times\n"   #<---- !!!!!!!!!!!!!!  L1  
[3] "Function 4 was called 1 times\n"   #<---- !!!!!!!!!!!!!!  L2 
[1] 5
[1] "Function cnt_add was called 2 times\n"
[2] "Function 3 was called 2 times\n"   #<---- !!!!!!!!!!!!!!  L3 
[3] "Function 9 was called 2 times\n"   #<---- !!!!!!!!!!!!!!   
[1] 12
cnt_mult<-counter(mult)
cnt_mult(1,6) 
[1] "Function cnt_mult was called 1 times\n"
[2] "Function 1 was called 1 times\n"   #<---- !!!!!!!!!!!!!!  L4  
[3] "Function 6 was called 1 times\n"   #<---- !!!!!!!!!!!!!!  L5  
[1] 6

a) I expected "Function ? was called ? times\n" but why L1,L2,L3,L4,L5 printed?

b) When I try to (like in python)

add <- counter(add)
add(3, 4)

I get an error: Error: evaluation nested too deeply....

c) To avoid error in b I tried as follows but still got an error

cnt_add <- counter(add)
add <- cnt_add
add(6, 8)

I find out if I call cnt_add function one time no error(except additional two lines in console) happen:

cnt_add <- counter(add)
cnt_add(1, 8)
[1] "Function cnt_add was called 1 times\n"
[2] "Function 1 was called 1 times\n"      
[3] "Function 8 was called 1 times\n"      
[1] 9
add <- cnt_add
add(6, 8)
[1] "Function add was called 2 times\n" "Function 6 was called 2 times\n"  
[3] "Function 8 was called 2 times\n"  
[1] 14

But why "Function add was called 2 times", I called it one times! Why it needs at least one time call to works?

How to fix these problems? I do not want other ways since this is just a practice in closures.

Answer 1

fname stores the function name. get(fname, mode="function") finds the function passed to counter.

counter = function(fn) {
  i = 0
  fname = deparse(substitute(fn))
  fn = get(fname, mode="function")
  function(...) {
    i <<- i+1
    cat(sprintf("Function %s was called %d times", fname, i), "\n")
    return(fn(...))
  }
}


add = function(a, b) a+b
add = counter(add)
add(1, 6)
Function add was called 1 times 
[1] 7
add(7, 6)
Function add was called 2 times 
[1] 13
 
mult = function(a, b) a*b
mult = counter(mult)
mult(2, 3)
Function mult was called 1 times 
[1] 6
mult(5, 3)
Function mult was called 2 times 
[1] 15

Answer 2

a) match.call gives you the whole call, not just the name of the function you called. Use match.call()[[1]] to get that. But deparse(substitute(fn)) gives you a string version of what you passed as fn, so it's probably better. (My choice gives the original function name, not the modified one. Stick with match.call()[[1]] if you want the modified one.)

b) You are being bitten by lazy evaluation. Call force(fn) in your definition of counter. The issue is that counter never evaluates fn, so it is left as a promise until it is needed the first time you call add. But at that point, the definition of add has changed, so you get the infinite loop. Using force(fn) forces the value of the promise to be determined.

counter<-function(fn){
  force(fn)
  name <- deparse(substitute(fn))
  cnt <- 0
  inner <- function(...){
    cnt <<- cnt+1
    print(paste("Function",name,"was called",cnt,"times\n"))
    return(fn(...))
  }
  return(inner)
  
}
add  <- function(a,b) a+b
mult <- function(a,b) a*b
add  <-counter(add)
add(1,4)
#> [1] "Function add was called 1 times\n"
#> [1] 5
add(3,9)
#> [1] "Function add was called 2 times\n"
#> [1] 12

^{Created on 2022-09-25 with reprex v2.0.2}

Answer 3

Using sprintf it's more similar. message might better suite the kind of output. Credits for match.call()[[1]] to @user2554330, I wrapped an as.character() around it.

counter <- function(fn) {
  cnt <- 0
  inner <- function(...) {
    cnt <<- cnt + 1
    message(sprintf("Function %s was called %s times", as.character(match.call()[[1]]), cnt))
    return(fn(...))
  }
  return(inner)
}

add <- function(a, b) a + b
mult <- function(a, b) a*b
cnt_add <- counter(add)

cnt_add(1, 4)
# Function cnt_add was called 1 times 
# [1] 5

cnt_add(3, 9)
# Function cnt_add was called 3 times
# [1] 12