如何检查表达式是否是传递给addTaskCallback的回调中的赋值？回调有四个参数。传递给回调的第一个参数是“顶级任务的S语言表达式”。 Top-level Task Callbacks in R手册建议您“检查表达式并确定是否进行了任何分配”。但是，我如何能够始终如一地为全球环境中的任何任务做到这一点？我基本上想知道在全局环境中是否添加或更改了任何对象，并且只有在这种情况下才执行我的回调。很容易检查基本的赋值操作，例如<-或=，但我不确定循环（这是一个顶级表达式），如果使用<<-的条件或函数运算符或可能的其他方式来更改全局环境中的对象。以下是包含全局环境中的分配的单个顶级操作的一些示例
# 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()
最后是一个检查简单=和<-运算符的基本示例：
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)
答案 0 :(得分：3)
所以，你基本上想知道是否在中添加或更改了任何对象 全局环境，只有在这种情况下才执行[你的]回调。。
这是一个非常简单的解决方案，利用（当前实验性的）base R函数lockEnvironment，可以防止给定环境发生任何变化。不幸的是，没有unlock*对应的，所以我们必须先执行this gist。
# 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
}
如果在评估给定TRUE时出错，则此函数返回expr。它在锁定全局环境的情况下运行，因此如果在全局环境中添加或更改了任何对象，您肯定会获得TRUE 。
一些例子：
globalChange({
x <- 100
})
## [1] TRUE
globalChange({
print("a")
})
## [1] "a"
## [1] FALSE
globalChange({
f <- function() { x <<- 100 }
f()
})
## [1] TRUE
答案 1 :(得分：1)
为了能够知道对象是否已被创建，修改或删除，您可以得到.GlobalEnv的先前状态的摘要 - 命名向量，名称是对象名称，值是哈希值（来自{{ 1}}包）。以下是有效的，但是当.GlobalEnv包含大R对象（在get.hash函数中）时会花费很多。
首先是一个调用digest的函数，它的参数是一个R对象名。
digest某些对象无法监控
get.hash = function( x ){
require( digest)
obj = get(x, envir = .GlobalEnv )
digest( obj, algo = "sha1" )
} # digest call
现在回调函数。因为可以使用 assign 或调用 assign 的函数，所以我不认为扫描'left assignment'和'equal'符号就足够了。对象的名称和哈希值将用于跟踪对象的签名。
# objects to exclude from ls :
obj.exclude = c(".Random.seed")
就是这样。
> .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
如果我放弃'修改'选项并仅监控创建和删除，则会更加简单和快速。
.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"))
}