chatty

gistfile1.txt

``` r
chatty <- function(x, f = identity) {
  caller_env <-  parent.frame()
  closure <- new.env(parent = caller_env)
  f_sym <- substitute(f)
  if (is.function(f)) {
    f_name <- as.character(f_sym)
    f <- list(f)
    if(is.symbol(f_sym) && ! f_name %in% c("", "identity")) {
      names(f) <- f_name
    }
  }
  if (is.null(names(f))) names(f) <- rep("", length(f))
  closure$f <- lapply(f, rlang::as_function)
  
  name <- as.character(substitute(x))
  closure$name <- name
  if(exists(name, caller_env, inherits = FALSE)) {
    closure$value <- x
    rm(list = name, envir = caller_env)
  }
  
  makeActiveBinding(
    name,
    function(v) {
      if(missing(v)) closure$value else {
        #browser()
        closure$value <- v
        var_name <- closure$name
        f <- closure$f
        f_names <- names(f)
        for (i in seq_along(f)) {
          f_name <- f_names[[i]]
          msg <- if (f_name != "") {
            sprintf("%s(%s):", f_name, var_name)
          }  else {
            sprintf("%s:", var_name)
          }
          message(msg)
          print(f[[i]](closure$value))
        }
      }
    },
    env = caller_env)
}

test <- function() {
  chatty(x)
  x <- letters
  x <- 3
  chatty(x, list(identity, length = length, head2 = ~ head(.,2)))
  x <- LETTERS
}
res <- test()
#> x:
#>  [1] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s"
#> [20] "t" "u" "v" "w" "x" "y" "z"
#> x:
#> [1] 3
#> x:
#>  [1] "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" "Q" "R" "S"
#> [20] "T" "U" "V" "W" "X" "Y" "Z"
#> length(x):
#> [1] 26
#> head2(x):
#> [1] "A" "B"
res
#>  [1] "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" "Q" "R" "S"
#> [20] "T" "U" "V" "W" "X" "Y" "Z"
```

<sup>Created on 2022-03-04 by the [reprex package](https://reprex.tidyverse.org) (v2.0.1)</sup>