To be able to know if objects have been created, modified or deleted, you could have a summary of the previous state of the .GlobalEnv - a named vector, names are objects names and values are hash values (from the digest
package). The following is working but cost a lot when .GlobalEnv contains big R objects (in the get.hash function).
First a function that is calling digest, its argument is an R object name.
get.hash = function( x ){
require( digest)
obj = get(x, envir = .GlobalEnv )
digest( obj, algo = "sha1" )
} # digest call
Some objects are not interesting to be monitored
# objects to exclude from ls :
obj.exclude = c(".Random.seed")
The callback function now. Because assign or functions that call assign could be used, I don't think scanning 'left assignment' and 'equal' symbols is enough. The names and hash value of objects will be used for tracing objects'signature.
.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"))
}
That's 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 drop the 'modify' option and monitor only creations and deletions, it's far simplier 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"))
}