CODEWITHSUNDEEP
rcall
Hillary Sanders
Hillary Sanders

Reputation: 6047

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?

Upvotes: 3

Views: 59

Answers (2)

Matthew Plourde
Matthew Plourde

Reputation: 44624

Using the ls and search functions, you could do something like this to attach as an attribute the namespace of the function to the expression generated by call.

call_with_ns <- function(name, ...) {
    found_namespace <- NA_character_
    for (namespace in search()) {
        if (name %in% ls(namespace)) {
            found_namespace <- namespace
            break
        }
    }

    result <- do.call(call, c(name, list(...)))
    attr(result, 'namespace') <- found_namespace
    result
}

foo = function(x){
  # do stuff
  return(x)
}
my_call = call_with_ns('foo', 10)
R_call = call_with_ns('round', 10.5)
library(gdata)
pkg_call = call_with_ns('trim', ' _ ')
attributes(my_call)
# $namespace
# [1] ".GlobalEnv"
attributes(R_call) 
# $namespace
# [1] "package:base"
attributes(pkg_call) 
# $namespace
# [1] "package:gdata"

Upvotes: 1

romants
romants

Reputation: 3648

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

Upvotes: 1

Related Questions