R: instrument function to capture all assignments

Question

Given a regular R function f, I'd like to be able to create a new function f_debug that acts just like f, but lets me keep track of all the assignments to function-local variables that happened inside it.

For example:

f <- function(x, y) {
  z <- x + y
  df <- data.frame(z=z)
  df
}

# This function doesn't work as intended - would like it to (in the case of `f` above)
# write out a list containing `z` and `df` to an RDS file
capturing <- function(func) {
  e <- new.env()
  altered <- function(...) {
    parent <- parent.frame()
    e <- something...(func, environment(), parent, etc., etc.)
    result <- func(...)
    saveRDS(as.list(e), 'foo.rds')
    result
  }
  environment(func) <- e
  altered
}

f_debug <- capturing(f)

I'm not sure whether my knowledge gap to do this is large or small, anyone have a solution?

Answer 1

Solution 1: Steal the function's code

Here's a solution which doesn't return a new function which captures intermediate calculations, but rather calls the given function's code internally. There's some limitations, such as it probably only works with named arguments. Instead of storing the intermediate calculations as an RDS, it attaches them as an attribute.

capturing <- function(fun, ...) { 
  fun <- match.fun(fun)
  code <- body(fun)
  parent <- environment(fun)
  env <- new.env(parent = parent)
  for (val in names(list(...))) {
    env[[val]] <- list(...)[[val]]
  }
  result <- eval(code, envir = env, enclos = parent.frame())
  attr(result, "intermediate") <- env
  result
}

my_add <- function(x, y) {
  z <- x+y
  u <- x-y
  w <- x*y
  x + y
}

intermediates <- function(x) {
  attr(x, "intermediate", exact = TRUE)
}

value <- capturing(my_add, x = 1, y = 7)
ls(envir = intermediates(value))
#> [1] "u" "w" "x" "y" "z"
intermediates(value)$x
#> [1] 1
# Created on 2022-02-08 by the reprex package (v2.0.1)

Solution 2: Modify the function's code

One weakness of this solution is that if the chosen function features a call to on.exit(add=FALSE), some additional work needs to be done to modify the function so the internal environment is captured. However, it does work when the function accepts ... arguments.

my_add <- function(x, y) {
  z <- x+y
  u <- x-y
  w <- x*y
  x + y
}

insert_capture <- function(code) {
  # `<<-` assigns into the global environment if no variable of the given name is found
  # while traveling up to the global environment. If you need this assignment to go elsewhere,
  # I'd recommend passing in `assign()`. Of course, you could also modify the `on.exit()`
  # to use saveRDS.
  parse(text=append(deparse(code), 
                            "on.exit(._last_capture <<- environment(), add = TRUE)",
                            after = 1L))
}
capturing2 <- function(fun) {
  fun <- match.fun(fun)
  code <- insert_capture(body(fun))
  body(fun) <- code
  fun 
}

my_add2 <- capturing2(my_add)

my_add2(1, 7)
#> [1] 8
ls(envir = ._last_capture)
#> [1] "u" "w" "x" "y" "z"
._last_capture$u
#> [1] -6

^{Created on 2022-02-08 by the reprex package (v2.0.1)}