r - 让 match.call() 与 *apply 和 plyr 一起工作？ (重新 : Referencing a dataframe recursively)

Question

以下函数的目的是允许更轻松地进行自引用分配。 (如此处建议: Referencing a dataframe recursively )

所以，而不是

 # this  
 myDataFrame$variable[is.na(myDataFrame$variable)] <- 0

 # we can have this: 
 NAto0(myDataFrame$variable)

这些函数适用于向量，但在 *ply'ing 时效果不佳

我遇到了关于 match.call() 的两个问题函数的一部分 selfAssign() (代码如下)。问题是:

如何从函数内部确定它是否被调用
来自 *apply 类型的函数？

我怎样才能回溯通话
到正确的变量环境？

我已经包含了参数 n至 selfAssign(.)这适用于 eval最后声明。我想知道我是否可以以某种方式利用 n类似于

 sapply(df, NAto0, n=2)

也许在 selfAssign 中有类似 sys.parent(n) 的东西(我试过了，要么我没有做对，要么不起作用)

任何建议将不胜感激。

职能

这些函数是 selfAssign 的包装器，将在 *apply 中使用。调用。

NAtoNULL <- function(obj, n=1) {
# replace NA's with NULL
  selfAssign(match.call()[[2]], is.na(obj), NULL, n=n+1)
}

NAto0 <- function(obj, n=1) {
# replace NA's with 0
  selfAssign(match.call()[[2]], is.na(obj), 0, n=n+1)
}

NAtoVal <- function(obj, val, n=1) {
  selfAssign(match.call()[[2]], is.na(obj), val, n=n+1)  
}

ZtoNA <- function(obj, n=1) {
# replace 0's with NA

  # TODO: this may have to be modified if obj is matrix
  ind <- obj == 0
  selfAssign(match.call()[[2]], ind, NA, n=n+1)
}

selfAssign是执行工作的函数以及错误来自哪里

selfAssign <- function(self, ind, val, n=1, silent=FALSE) {
## assigns val to self[ind] in environment parent.frame(n)
## self should be a vector.  Currently will not work for matricies or data frames

  ## GRAB THE CORRECT MATCH CALL
  #--------------------------------------
      # if nested function, match.call appropriately
      if (class(match.call()) == "call") {
        mc <- (match.call(call=sys.call(sys.parent(1))))   ## THIS LINE PROBABLY NEEDS MODIFICATION
      } else {
        mc <- match.call()
      }

      # needed in case self is complex (ie df$name)
      mc2 <- paste(as.expression(mc[[2]]))


  ## CLEAN UP ARGUMENT VALUES
  #--------------------------------------
      # replace logical indecies with numeric indecies
      if (is.logical(ind))
        ind <- which(ind) 

      # if no indecies will be selected, stop here
      if(identical(ind, integer(0)) || is.null(ind)) {
        if(!silent) warning("No indecies selected")
        return()
      }

      # if val is a string, we need to wrap it in quotes
      if (is.character(val))
        val <- paste('"', val, '"', sep="")

      # val cannot directly be NULL, must be list(NULL)
      if(is.null(val))
        val <- "list(NULL)"


  ## CREATE EXPRESSIONS AND EVAL THEM
  #--------------------------------------
     # create expressions to evaluate
     ret <- paste0("'[['(", mc2, ", ", ind, ") <- ", val)

     # evaluate in parent.frame(n)
     eval(parse(text=ret), envir=parent.frame(n))
}

Answer 1

请注意，我不赞同这种类型的东西，但确实赞同了解 R 的工作原理的愿望，以便您可以根据需要进行这些工作。

以下适用于 sapply只是，所以它只能部分回答您的问题，但它确实列出了您可以采取的策略。正如我在之前的评论中所指出的，要做到这一点非常困难，但我可以在 sapply 的特定上下文中回答 1 和 2。称呼

使用 sys.calls获取跟踪堆栈

使用 sys.frame和 sys.parents获取合适的评测环境

一个非健壮的说明性实现，它使用您想要的策略类型将列表中的所有向量转换为 NA:

get_sapply_call <- function(x) get_sapply_call_core(x)  # To emulate your in-between functions
get_sapply_call_core <- function(x) {
  if((c.len <- length(s.calls <- sys.calls())) < 4L) return("NULL")
  if(s.calls[[c.len - 2L]][[1L]] == quote(lapply) &     # Target sapply calls only
     s.calls[[c.len - 3L]][[1L]] == quote(sapply) &
     s.calls[[c.len - 1L]][[1L]] == quote(FUN)) {
    mc.FUN <- s.calls[[c.len - 1L]]
    mc.sa <- match.call(definition=sapply, s.calls[[c.len - 3L]])  # only need to match sapply b/c other calls are not user calls and as such structure is known
    call.txt <- paste0(
      as.character(mc.sa[[2L]]), "[[", mc.FUN[[2L]][[3L]], 
      "]] <- rep(NA, length(", as.character(mc.sa[[2L]]), "[[", mc.FUN[[2L]][[3L]], 
      "]]))"
    )
    call <- parse(text=call.txt)
    eval(call, envir=sys.frame(sys.parents()[c.len - 3L]))
    return(call.txt)
  }
  return("NULL")
}
df <- data.frame(a=1:10, b=letters[1:10])
sapply(df, get_sapply_call)
#                                     a                                     b 
# "df[[1]] <- rep(NA, length(df[[1]]))" "df[[2]] <- rep(NA, length(df[[2]]))" 
df
#     a  b
# 1  NA NA
# 2  NA NA
# 3  NA NA
# 4  NA NA
# ...

不同的 *apply 需要不同的逻辑函数，甚至更多不同的逻辑，如果您的函数以其他方式被间接调用。此外，这绝对是一个快速而肮脏的实现，所以即使对于 sapply您可能需要添加一些东西以使其更加健壮。并且不能保证 sapply实现在 future 不会改变打破上述所有。

编辑:请注意，您可以完全回避 match.call 遇到的问题