Cool R Functions

get_current_function_call_hierarchy.R

get_current_function_call_hierarchy<- function(only_function_names = T){
  call_list <- sys.status()$sys.calls
  call_list <- call_list[-length(call_list)]
  call_list <- call_list[-length(call_list)]
  if(length(call_list)==0){
    return(character(0))
  }
  if(!only_function_names){
    return(as.character(call_list))
  }
  return(call_list %>% lapply(as.character) %>% lapply("[[",1) %>% unlist())
}

sample_use(get_current_function_call_hierarchy).R

f <-  function(test = T){
  h<- function(){
    get_current_function_call_hierarchy()
  }
  j<-function(){
    h()
  }
  k<- function(){
    j()
  }
  if(test){
    h()
  }else{
    k()
  }
  
}

sample_use(slow_function).R

f <- function(x){
  x+1+slow_inside()
}

x <- f
for(i in 1:5){
  print(x(1))
  x<-slow_me(x)
}

slow_function.R

slow_me<- function(f){
  # making clone of the function otherwise same object will refer in following line
  slow_function <- f
  h <- function(...){
    slow_function(...)
  }
  return(h)
}


slow_inside <- function(){
  f_c_now <- g()
  num <- table(f_c_now)["slow_function"] %>% as.numeric()
  if(!is.na(num)){
    return(num)
  }else{
    return(0)
  }
}