R/countCalls.R

In duncantl/CallCounter: Run-time code measurement and tools for helping debugging

genCounter =
function()
{
    ctr = 0L
    inc = function()
        ctr <<- ctr + 1L
    structure(list(inc = inc, value = function() ctr, reset = function() ctr <<- 0L), class = "CallCounter")
}


genMultiCounter =
function(names = character())
{
    ctr = integer()
    ctr[names] = 0L
    
    inc = if(length(names)) 
              function(what)
                 ctr[what] <<- ctr[what] + 1L
           else
             function(what) {
                 if(what %in% names(ctr))
                     ctr[what] <<- ctr[what] + 1L
                 else
                     ctr[what] <<- 1L
             }


    
    structure(list(inc = inc,
                   value = function() ctr,
                   reset = function(full = FALSE) {
                               if(full)
                                  ctr <<- integer
                               else
                                   ctr[] <<- 0L
                           }),
              class = "CallCounterMultipleFuns")
}


countCalls =
function(obj, counter = genCounter(), env = globalenv(), print = FALSE)
{
    f = counter$inc
    e = substitute(trace(fun, f, print = print), list(fun = deparse(substitute(obj)), f = f, print = print))
    eval(e, env)
    counter
}

countMCalls =
    #
    # Can just create the initial integer() vector with the names of funs
    # and that simplifies the updating as the element is guaranteed to be there. Updated genMultiCounter() also.
    #
    #
function(..., counter = genMultiCounter(funNames), env = globalenv(), print = FALSE,
         funs = substitute(list(...))[-1],
         funNames = sapply(funs, as.character))
{
 #    k = sys.call() m = match.call(countMCalls, k)
    
    f = counter$inc
    e = substitute(trace(fun, quote((f)(name)), print = print), list(f = f, print = print))

    for(i in seq(along = funs)) {
        e[[2]] = funs[[i]]
        e[[3]] [[2]][[2]] = as.character(funs[[i]])
        eval(e, env)
    }
    counter
}



if(FALSE) {
 z = genCounter()
 trace(rnorm, z$inc)
 replicate(10, rnorm(1))

 ctr1 = countCalls(dnorm)
 invisible(replicate(10, dnorm(1)))
 ctr1$value()
}


if(FALSE) {
f = function() { trace(dnorm, function() cat("hi\n"))}
f()
dnorm(1)
untrace(dnorm)

f = function(obj) {
     e = substitute(trace(what, function() cat("hi 2\n")), list(what = deparse(substitute(obj))))
browser()     
     eval(e, globalenv())
 }
f(dnorm)
dnorm(1)
}