Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How can I access arguments of a call to a function stored in a custom environment?

Tags:

r

rlang

I am in the following situation:

  • I use a custom environment (some_env) that stores a list of functions (such as some_function()). Note that I don’t own this environment, it is imported from another package
  • I have a user-facing function that calls the function stored in the environment under the hood.
library(rlang)

# Define a custom environment where I store a function.
# This is done in another package.
some_env <- new.env(parent = emptyenv())
class(some_env) <- "custom_class"
some_env$some_function <- function(x) {
  print(x)
}

# Make a user-facing function that calls the function stored in the custom
# environment under the hood
user_facing_fn <- function(val = 1) {
  some_env$some_function(val)
}

user_facing_fn()
#> [1] 1

My objective is to capture the call to this internal function (some_function()). I could do this inside user_facing_fn() using rlang::expr() and !!. However, in the real situation, I have many user-facing functions so using this combination would greatly clutter the code.

Therefore, I thought about defining a custom class and $ call so that I can access the call before dispatching it to the next method.

# Define a custom `$` to access the call before evaluating it 
`$.custom_class` <- function(x, name) {
  fc <- rlang::frame_call()
  
  ### For debugging
  cat("----------------\n")
  print(fc)
  cat("----------------\n")
  print(str(fc))
  cat("----------------\n")
  print(deparse(fc))
  ###
  
  NextMethod("$")  # <<<<<<<<<<<<< Not interested in this part
}

It seems that I can capture the call with frame_call() and it is correctly printed (see the first printed line below):

user_facing_fn()
#> ----------------
#> some_env$some_function(val)
#> ----------------
#>  language `$.custom_class`(some_env, "some_function")
#>  - attr(*, "srcref")= 'srcref' int [1:8] 14 3 14 29 3 29 14 14
#>   ..- attr(*, "srcfile")=Classes 'srcfilecopy', 'srcfile' <environment: 0x000001d40b90c0c0> 
#> NULL
#> ----------------
#> [1] "`$.custom_class`(some_env, \"some_function\")"
#> [1] 1

However, I can’t find a way to access the value of val after storing the expression in fc. As you can see, it is deparsed as `$.custom_class`(some_env, "some_function") but I cannot access val. I tried many rlang functions but couldn’t find something that works.

To clarify, what I want is to be able to access the value of val (in the example above, it would be 1) when I’m inside $.custom_class. Is this possible? I’m fine with using either base R or rlang.


Edit following MrFlick's comment:

My objective is that user_facing_fn() returns the output and an attribute containing the call to the internal function, like this:

...

# Make a user-facing function that calls the function stored in the custom
# environment under the hood
user_facing_fn <- function(val = 1) {
  my_expr <- expr(some_env$some_function(!!val))
  out <- eval_bare(my_expr)
  attr(out, "original_query") <- my_expr
  out
}

user_facing_fn(3)
#> [1] 3
#> attr(,"original_query")
#> some_env$some_function(3)

The problem is that I have many user-facing functions, and in some of them I want to capture several calls to functions stored in some_env. Therefore, I thought that instead of duplicating this expr() + !!, I could automatically capture the call in $ and I wouldn't need to modify the user-facing functions (or just slightly).

like image 998
bretauv Avatar asked Dec 01 '25 16:12

bretauv


1 Answers

I think I found a way thanks to the various comments.

Setup

I’m just putting back my setting here:

library(rlang)

# Define a custom environment where I store a function.
# This is done in another package.
some_env <- new.env(parent = emptyenv())
class(some_env) <- "custom_class"
some_env$some_function <- function(x) {
  x
}

# Make a user-facing function that calls the function stored in the custom
# environment under the hood
user_facing_fn <- function(val = 1) {
  some_env$some_function(val)
}

user_facing_fn(1)
#> [1] 1

Modify the environment

I can modify the functions in some_env so that I can obtain the call and store it somewhere (e.g in an attribute) before evaluating it. First I need eapply() to go through all the functions stored in some_env (in this example, there’s only some_function()):

modify_env <- function(env) {
  
  # Here I overwrite all functions defined in `some_env`. In this example,
  # there's only one.
  
  eapply(env, function(fun) {
    function(...) {
      # Evaluate the args that are passed to the `some_function()`, which is
      # only "val" in this example.
      # First we capture unevaluated args, then we evaluate each of them in the
      # caller env.
      
      fc <- as.list(frame_call())
      # The first element is the call, which is `some_env$some_function()` here.
      # It is not an argument so I remove it.
      fc1 <- fc[[1]]
      fc[[1]] <- NULL
      fc <- lapply(fc, eval_bare, env = caller_env())
      
      # Evaluate the call. This produces the output (which is equal to the 
      # input in this example).
      out <- call2(fun, !!!fc) |> eval_bare()
      
      # Build the call that will be stored in the attributes of the output.
      args <- list2(...)
      full_call <- call2(fc1, !!!fc)
      full_call <- deparse(full_call)
      
      # Store the call in the attribute of the output.
      attr(out, "original_expr") <- full_call
      out
    }
  })
}

Now I define my own environment by cloning some_env and then modify it:

my_new_env <- modify_env(
  env_clone(some_env)
)

Finally, I define a custom $ to access the call to some_env$some_function() before evaluating it. Here, instead of returning some_env$some_function, which would only return the input without storing the call, I return the modified function from the custom environment:

`$.custom_class` <- function(x, name) {
  my_new_env[[name]]
}

We now have the original call stored in the output’s attributes:

user_facing_fn()
#> [1] 1
#> attr(,"original_expr")
#> [1] "some_env$some_function(1)"


user_facing_fn(3)
#> [1] 3
#> attr(,"original_expr")
#> [1] "some_env$some_function(3)"
like image 57
bretauv Avatar answered Dec 03 '25 07:12

bretauv



Donate For Us

If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!