I figured out two different approaches to my own question above. Both of them use something I would call 'deep function hacking' which is probably not a recommended way of doing this - at least it doesn't look like one should be doing this at all. Before playing around I didn't know this was even possible. Probably there are cleaner and more recommended ways of doing this, therefore I leave this questions open for other approaches.
First approach
I call the function of the first approach make_visible
. Basically, this function constructs a new function using the body parts of foo
and wrapping those with for
loops in (
and then in withAutoprint
. It is quite hacky, and only works on the first level of a function (it won't show the deeper structure of, for example, functions that use pipes).
make_visible <- function(.fx) {
if (typeof(.fx) %in% c("special", "builtin")) {
stop("`make_visible` cannot be applied to primitive functions")
}
if (! typeof(.fx) %in% "closure") {
stop("`make_visible` only takes functions of type closures as argument")
}
# make environment of .fx parent environment of new function environment
org_e <- environment()
fct_e <- environment(.fx)
parent.env(org_e) <- fct_e
# get formals and body of input function .f
fct_formals <- formals(.fx)
fct_body <- body(.fx)[-1]
# create a minimal example function for `(`
.f1 <- function(x) {
(x)
}
# extract its body
.f1_body <- body(.f1)[-1]
# build a new function .f2 by combining .f and .f1
.f2 <- function() {}
for (i in seq_along(1:length(fct_body))) {
.f1_body[[1]][[2]]<- fct_body[[i]]
body(.f2)[[1+i]] <- .f1_body[[1]]
}
# extract the body of new function .f2
.f2_body <- body(.f2)[-1]
# create a minimal example function .f3 for `withAutoprint`
.f3 <- function() {
withAutoprint({
x
})
}
# insert body part of .f2 into .f3
for (j in seq_along(1:length(.f2_body))) {
body(.f3)[[2]][[2]][[1+j]] <- .f2_body[[j]]
}
# give .f3 the formals of input function
formals(.f3) <- fct_formals
# return .f3 as new function
.f3
}
Which yields the following outcome:
foo2 <- make_visible(foo)
foo2(1)
> (line1 <- x)
> [1] 1
> (line2 <- 0)
> [1] 0
> (line3 <- line1 + line2)
> [1] 1
> (return(line3))
> [1] 1
This approach has a couple of downsides:
1. Wrapping the output of each line into brackets reduced the readability
2. Further, this approach returns a not the value of the original function, but a list with two elements, the original result value
and a logical vector visible
, which makes it harder to use the output of this function, especially when using it inside a map
call.
foo2(1) %>% str
# > (line1 <- x)
# [1] 1
# > (line2 <- 0)
# [1] 0
# > (line3 <- line1 + line2)
# [1] 1
# > (return(line3))
# [1] 1
# List of 2
# $ value : num 1
# $ visible: logi TRUE
purrr::map(1:3, foo2)
# > (line1 <- x)
# [1] 1
# > (line2 <- 0)
# [1] 0
# > (line3 <- line1 + line2)
# [1] 1
# > (return(line3))
# [1] 1
# > (line1 <- x)
# [1] 2
# > (line2 <- 0)
# [1] 0
# > (line3 <- line1 + line2)
# [1] 2
# > (return(line3))
# [1] 2
# > (line1 <- x)
# [1] 3
# > (line2 <- 0)
# [1] 0
# > (line3 <- line1 + line2)
# [1] 3
# > (return(line3))
# [1] 3
# [[1]]
# [[1]]$value
# [1] 1
#
# [[1]]$visible
# [1] TRUE
#
#
# [[2]]
# [[2]]$value
# [1] 2
#
# [[2]]$visible
# [1] TRUE
#
#
# [[3]]
# [[3]]$value
# [1] 3
#
# [[3]]$visible
# [1] TRUE
Second approach
While make_visible
is a direct approach on my idea of rewriting a function by making each line visible and wrapping it in withAutoprint
the second approach rethinks the problem. It is a similar 'deep function hack', looping over body parts of the original function, but this time (1) printing them to console, (2) capturing their evaluated output, (3) printing this output to console, and then (4) actually evaluating each body part. Finally the original function is called and returned invisibly.
reveal <- function(.fx) {
if (typeof(.fx) %in% c("special", "builtin")) {
stop("`reveal` cannot be applied to primitive functions")
}
if (! typeof(.fx) %in% "closure") {
stop("`reveal` only takes functions of type closures as argument")
}
# environment handling
# get environment of .fx and make it parent.env of reveal
org_e <- environment()
fct_e <- environment(.fx)
parent.env(org_e) <- fct_e
# get formals of .fx
fct_formals <- formals(.fx)
# get body of .fx without first part {
fct_body <- body(.fx)[-1]
# define new function to return
.f2 <- function() {
# loop over the body parts of .fx
for (.i in seq_along(1:length(fct_body))) {
# print each body part
cat(paste0(as.list(fct_body)[.i],"\n"))
# check whether eval returns output and if not use eval_tidy
if (length(capture.output(eval(fct_body[[.i]]))) == 0) {
# write output of eval as string
out <- capture.output(rlang::eval_tidy(fct_body[[.i]]))
} else {
# write output of eval as string
out <- capture.output(eval(fct_body[[.i]]))
}
# print output of evaluation
cat(out, sep = "\n")
# evaluate
eval(fct_body[[.i]])
}
# get arguments
.args <- match.call(expand.dots = FALSE)[-1]
# run .fx with .args and return result invisibly
invisible(do.call(.fx, as.list(.args)))
}
# replace formals of .f2 with formals of .fx
formals(.f2) <- fct_formals
# replace environment of .f2 with env of reveal to which env of .fx is a parent environment
environment(.f2) <- org_e
# return new function .f2
.f2
}
The output looks similar but somewhat cleaner:
reveal(foo)(1)
> line1 <- x
> [1] 1
> line2 <- 0
> [1] 0
> line3 <- line1 + line2
> [1] 1
> return(line3)
> [1] 1
This second approach is better because it's more readable and it returns the same value as the original function. However, at the moment I havent't been able to make it work inside a map
call. This is probably due to messing with the function environments.
foo2 <- reveal(foo)
purrr::map(1:3, foo2)
#> Error in (function (x) : object '.x' not found