TobCap

// ConcurrentDictionary
public static Func<T1, TResult> ConcurrentMemoizer<T1, TResult>(this Func<T1,  TResult> f)
{
    var dic = new ConcurrentDictionary<T1, Lazy<TResult>>();
    return (x) =>
    {
        return dic.GetOrAdd(x, new Lazy<TResult>(() => f(x))).Value;
    };
}

TobCap

as.quote <- function(.x){
  expr.org <- eval(substitute(substitute(.x)), parent.frame())
  if (any(c("quote", "as.name", "as.symbol") %in% all.names(expr.org))) .x
  else expr.org
}

TobCap

# see ?do.call

# The second argument in do.call are evaluated in the calling environmnet before passing to Internal function.
# If an original function requires its arguments as expression, language, or call objects,
# they are needed to be quoted, or set do.call option as quote = TRUE.

D(quote(x^5), "x") # works

do.call(D, list(quote(x^5), "x")) # not work
do.call(D, list(quote(x^5), "x"), quote = TRUE) # works 

TobCap

show.frames <- function(x) {
  print(paste0("stacks: ",
    paste(head(sys.parents(), -1), collapse = " ")));
  print(paste0("vals: ", 
    paste(unlist(x), collapse = " ")));
}
g5 <- function(x) function(y) function(z) function(a) function(b) {
  x + y + z + a + b
}
  

TobCap

library(microbenchmark)
microbenchmark(
  do.call = do.call("function", list(as.pairlist(alist(x=)), NULL)),
  eval = eval(call("function", as.pairlist(alist(x=)), NULL)),
  as.function = as.function(alist(x = , NULL)),
  as.function.default = as.function.default(alist(x = , NULL)),
  "function(x) NULL" = function(x) NULL
)
# Unit: nanoseconds
#                expr   min    lq median      uq    max neval

TobCap

xl.col <- (function(x){
  alphabet2number <- function(x){
    xx <- strsplit(toupper(x), "")[[1]]
    vals <- vapply(xx, function(z) match(z, LETTERS), 0)
    pow <- 26 ^ ((nchar(x) - 1):0)
    # as.numeric(vals %*% pow)
    `dim<-`(vals %*% pow, NULL)
  }
  number2alphabet <- function(x) {
    n <- trunc(log(x) / log(26)) + 1

TobCap

## tco() is defined at https://github.com/TobCap/R/blob/master/tailCallOptimization.r

even <- function(n) if (n == 0) TRUE  else odd(n - 1)
odd  <- function(n) if (n == 0) FALSE else even(n - 1)

even2 <- function(n) if (n == 0) TRUE  else function() odd2(n - 1)
odd2  <- function(n) if (n == 0) FALSE else function() even2(n - 1)

## Both essentially have the same functionality and semantics.
trampoline.loop <- function(f) {

TobCap

# target example
lang1 <- quote({
  if(n > 0) a + b ^ c * d / e
  else if (n < 0) a - b %% sin(c * log(d)) ^ e
  else NA
})

# http://cran.r-project.org/doc/manuals/r-release/R-lang.html#Substitutions
replace.symbol <- function(expr, before, after){
  stopifnot(is.language(expr) && is.symbol(before))

TobCap

f <- function(x) x + 1
str(f)
attributes(f)
str((attr(f, "srcref")))
class((attr(f, "srcref")))
attributes((attr(f, "srcref")))
attr((attr(f, "srcref")), "srcfile") # environment
attr((attr(f, "srcref")), "class") # string 
ls.str(attr((attr(f, "srcref")), "srcfile")) 
ls.str(utils:::getSrcfile(f))

TobCap

f <- function(..., do.print = TRUE, do.benchmark = TRUE){
  # Interestingly, those returns the same result
  # as.list(substitute(list(...)))[-1]
  # as.list(substitute(c(...)))[-1]
  # as.list(substitute((...)))[-1]
  # as.list(substitute({...}))[-1] # bit slow

  d1 <- as.pairlist(lapply(substitute((...)), identity)[-1])
  d2 <- as.pairlist(as.list(substitute((...)))[-1]) # `as.list` is slow due to a generic function.
  d3 <- as.pairlist(as.vector(substitute((...)), "list")[-1])