Search code examples
rcall

Determine programmatically if a function call refers to your own function or a package's (or base R's) function?

What is the best way to programmatically figure out if a function call refers to your own function or a package's (or base R's) function?

Basically, I'm writing my own error recover function, and I want to allow the user to only see traceback messages for the functions that the user (I) have written. 

foo = function(x){
  # do stuff
  return(x)
}
my_call = call('foo', 10)
R_call = call('round', 10.5)
library(gdata)
pkg_call = call('trim', ' _ ')
attributes(my_call) # NULL
attributes(R_call) # NULL
attributes(pkg_call) # NULL

Is there any way to programmatically differentiate between my_call, pkg_call, and R_call?

Solution

  • One of the possible ways to achieve that is to use getAnywhere from utils package and determine where the called function is defined (user function will always be defined in .GlobalEnv and will mask other definitions). For example, 

    > foo = function(x){
+     # do stuff
+     return(x)
+ }
> my_call = call('foo', 10)
> R_call = call('round', 10.5)
> library(gdata)
> pkg_call = call('trim', ' _ ')
> is_user_function_call <- function(call) '.GlobalEnv' %in% getAnywhere(as.character(call[[1]]))$where
> is_user_function_call(my_call)
[1] TRUE
> is_user_function_call(R_call)
[1] FALSE
> is_user_function_call(pkg_call)
[1] FALSE

    Essentially what is_user_function does is checks whether the called function is defined in .GlobalEnv.

    When using the getAnywhere, there is essentially no difference between functions in base packages and other packages:

    > getAnywhere('round')$where
[1] "package:base"   "namespace:base"
> getAnywhere('trim')$where
[1] "package:gdata"   "namespace:gdata"

    So if you want to do distinguish between functions base/recommended packages and third-party packages, you will need to be checking it against the list of the packages. Something like this

    > ip <- installed.packages() 
> base.packages <- ip[ ip[,"Priority"] %in% c("base"), "Package"]
> recommended.packages <- ip[ ip[,"Priority"] %in% c("recommended"), "Package"]
> is_base_function_call <- function(call) any(sapply(base.packages, grepl, x=getAnywhere(as.character(call[[1]]))$where))
> is_recommended_function_call <- function(call) any(sapply(recommended.packages, grepl, x=getAnywhere(as.character(call[[1]]))$where))
> is_package_function_call <- function(call) !is_user_function_call(call) && !is_base_function_call(call) && !is_recommended_function_call(call)
> is_base_function_call(R_call)
[1] TRUE
> is_base_function_call(pkg_call)
[1] FALSE
> is_package_function_call(pkg_call)
[1] TRUE