How to check if an expression was a destination? (the `addTaskCallback` is passed in the callback)

Question

how can I check if the expression was the destination in the callback passed to addTaskCallback ? The callback takes four arguments. The first argument passed to the callback is "S-language expression for the top-level task." The Top-Level Job Handbook in R suggests that you can "examine the expression and determine if any jobs have been completed." But how can I do this consistently for any assignments in a global environment? I basically want to know if any objects have been added or changed in the global environment and only perform my callback if that is the case. It's easy to check for basic assignment operations, such as <- or = , but I'm not sure about loops (which are one of the top-level expressions) if conditions or functions that use the <<- operator, or other possible ways to change objects in the global environment . Here are a few examples of single top-level operations that include assignments in a global environment.

 # loops for (i in 1:10) x[i] <- i for (i in 1:10) { x[i] <- i y[i] <- i } # if conditions if(cond) x <- rnorm(1000) if(cond) { x <- rnorm(1000) y <- rnorm(1000) } # global assignment in loop fn = function() x <<- rnorm(1000) fn() 

And finally, a very simple example that checks the simple operators = and <- :

 eventHandler = function(expr, value, ok, visible) { if(class(expr) %in% c('=','<-')) print('assignment!') # as.character(expr)[2] should now reference the object that was changed TRUE } addTaskCallback(eventHandler) 

Answer 1

To find out if objects were created, modified, or deleted, you can get a summary of the previous state .GlobalEnv is a named vector, names are object names, and values ​​are hash values ​​(from the digest package). The following works, but costs a lot when .GlobalEnv contains large R objects (in the get.hash function).

First, the function that calls digest, its argument is the name of the object R.

 get.hash = function( x ){ require( digest) obj = get(x, envir = .GlobalEnv ) digest( obj, algo = "sha1" ) } # digest call 

Some objects are not of interest for observation.

 # objects to exclude from ls : obj.exclude = c(".Random.seed") 

Now the callback function. Since the assignment or functions that assign the call can be used, I don’t think it’s enough to copy the “abandoned assignment” and “equal” characters. The names and hash value of objects will be used to track objects.

 .my.callback.fun <- function() { old = ls( envir= .GlobalEnv, all.names = TRUE ) old = setdiff( old, obj.exclude ) options( "old_desc" = sapply( old, get.hash ) ) eventHandler <- function(...) { # get the previous .GlobalEnv old_desc = getOption( "old_desc") # get the previous .GlobalEnv old = names( old_desc ) # list the current .GlobalEnv new = ls( envir= .GlobalEnv, all.names = TRUE ) new = setdiff( new, obj.exclude ) new_desc = sapply( new, get.hash ) if (!all( is.element( old, new ) ) ) message("deleted objects: " , paste( old[!is.element( old, new )], collapse = ", " ) ) if (!all( is.element( new, old ) ) ) message("new objects: " , paste( new[!is.element( new, old )], collapse = ", " ) ) common_list = intersect(old, new ) is_equal_test = new_desc[common_list] == old_desc[common_list] if( !all( is_equal_test ) ) message("modified objects: " , paste( common_list[!is_equal_test], collapse = ", " ) ) options( "old_desc" = new_desc ) TRUE } invisible(addTaskCallback(f = eventHandler, name = "my_event_handler")) } 

What is it.

  > .my.callback.fun () # start the callback function
 Loading required package: digest
 > 
 > # your R commands here
 > x = 1:10
 new objects: x
 > y = rnorm (100)
 new objects: y
 > rm (x)
 deleted objects: x
 > for (i in 1:10) 
 + z = rep (i, 1000)
 new objects: i, z
 > rm (z, y)
 deleted objects: y, z
 > if (TRUE)
 + h = rnorm (1000)
 new objects: h
 > h = rnorm (1000)
 modified objects: h
 > fn = function () assign ("x", rnorm (1000), envir = .GlobalEnv)
 new objects: fn
 > fn ()
 new objects: x
 > 
 > iris = iris
 new objects: iris
 > iris [5.1] = 0.0
 modified objects: iris
 > 
 > removeTaskCallback (id = "my_event_handler") # stop the callback function
 [1] TRUE

If I remove the “edit” option and control only the creation and deletion, it is much easier and faster.

 .my.callback.fun <- function() { .old <- ls( envir= .GlobalEnv, all.names = TRUE ) options( "old_ls" = .old ) eventHandler <- function(...) { # list the current .GlobalEnv new <- ls( envir= .GlobalEnv, all.names = TRUE ) old = getOption( "old_ls") # get the previous .GlobalEnv if (!all( is.element( old, new ) ) ) message("deleted objects: ", paste( old[!is.element( old, new )], collapse = ", " ) ) if (!all( is.element( new, old ) ) ) message("new objects: ", paste( new[!is.element( new, old )], collapse = ", " ) ) options( "old_ls" = new ) TRUE } invisible(addTaskCallback(f = eventHandler, name = "my_event_handler")) } 

Answer 2

So, you basically want to know if any objects have been added or changed in the global environment and only perform [your] callback, if so.

Here's a pretty simple solution using the (currently experimental) base R lockEnvironment function, which prevents any changes to the given environment. Unfortunately, there is no analogue of unlock* , so first you need to fulfill this meaning .

 # source *https://gist.github.com/wch/3280369* first globalChange <- function (expr, envir = parent.frame()) { lockEnvironment(.GlobalEnv, TRUE) ..change <- FALSE tryCatch({ eval(expr, envir=envir) }, error=function(err) { # you may want to check whether err is "cannot add bindings to a locked environment" here ..change <<- TRUE }) unlockEnvironment(.GlobalEnv) # see https://gist.github.com/wch/3280369 # unlock all bindings (unlockEnvironment doesn't do that) for (obj in ls(envir=.GlobalEnv, all=TRUE)) unlockBinding(obj, .GlobalEnv) ..change } 

This function returns TRUE if an error occurred while evaluating the given expr . It starts with a closed global environment, so you will definitely get TRUE if any objects were added or changed in the global environment.

Some examples:

 globalChange({ x <- 100 }) ## [1] TRUE globalChange({ print("a") }) ## [1] "a" ## [1] FALSE globalChange({ f <- function() { x <<- 100 } f() }) ## [1] TRUE