如何检查表达式是否为赋值？(在回调中传递给`addTaskCallback`)

Question

如何检查表达式是否是传递给回调的赋值addTaskCallback？回调有四个参数.传递给回调的第一个参数是"顶级任务的S语言表达式".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)

Answer 1

为了能够知道对象是否已被创建、修改或删除，您可以获取 .GlobalEnv 先前状态的摘要 - 一个命名向量，名称是对象名称，值是哈希值（来自包）digest。以下方法有效，但当 .GlobalEnv 包含大 R 对象（在 get.hash 函数中）时，成本很高。

首先是一个调用digest的函数，它的参数是一个R对象名称。

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

有些对象没有必要被监视

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

现在的回调函数。因为可以使用分配或调用分配的函数，所以我认为扫描“左分配”和“等于”符号就足够了。对象的名称和哈希值将用于跟踪对象的签名。

.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"))
}

就是这样。

> .my.callback.fun() # 启动回调函数
加载所需包：digest
>
> # 这里是你的 R 命令
> x = 1:10
新对象：x
> y = rnorm(100)
新对象：y
> rm(x)
删除的对象：x
> for (i in 1:10)
+ z = 代表(i, 1000 )
新对象：i、z
> rm( z, y )
删除的对象：y、z
> 如果（真）
+ h = r范数(1000)
新对象：h
> h = rnorm(1000)
修改对象：h
> fn = function() 分配( "x", rnorm(1000), envir = .GlobalEnv )
新对象：fn
> fn()
新对象：x
>
> 虹膜 = 虹膜
新对象：虹膜
> 虹膜[5,1] = 0.0
修饰对象：虹膜
>
> removeTaskCallback(id = "my_event_handler" ) # 停止回调函数
[1] 正确

如果我放弃“修改”选项并仅监视创建和删除，那么它会更简单、更快。

.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"))
}