让 match.call() 与 *apply & plyr 一起工作？（re：递归引用数据框）答案

【问题标题】：getting match.call() to work with *apply & plyr? (re: Referencing a dataframe recursively)让 match.call() 与 *apply & plyr 一起工作？（re：递归引用数据框）
【发布时间】：2012-11-17 06:31:14
【问题描述】：

以下函数的目的是让自引用分配更容易。（这里建议：Referencing a dataframe recursively）

所以，而不是

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

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

这些函数对向量很有效，但在 *ply'ing 时效果较差

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

如何从函数中确定它是否被调用来自 *apply-type 函数？
如何追溯呼叫到正确的变量环境？

我已将参数 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))
}

【问题讨论】：

另外，我意识到df[is.na(df)] <- 0 是上述特定sapply 语句的更简单替代方案。我当然希望将这一点概括为类似陈述会很麻烦的情况。
通常的警告：R 是一种按值传递的语言，你试图通过修改传递给函数的对象来违背自然，而不必用函数的输出重新分配它们，即你想做f(x) 而不是x <- f(x)。恕我直言，这既危险又困难。但是，有些软件包可以让您通过引用进行传递：R.oo、proto，也许更多。
有趣的是，您可能遇到与基本 Recall 函数相同的困难。来自文档：当作为函数参数传递时，“Recall”将无法正常工作，例如到“应用”函数族。.
@flodel，感谢您指出召回。你可能有类似的原因是对的。至于通常的警告，也谢谢你。这当然很困难，但我愿意更多地了解潜在的危险和陷阱
这里的特殊问题（......在不存在的情况下使用）是您正在匹配从 sapply 发出的调用到您的函数，并且该调用包括...，但是您的函数没有。有一些方法可以解决这个问题，但更大的问题是，即使您匹配调用，sapply 使用的变量名称也是X，这可能不是您要设置的变量的名称。您必须一直挖掘调用堆栈才能找到实际的变量名称。对于非常具体的情况（例如 sapply），您可能可以这样做，但几乎不可能一概而论。

标签： r plyr apply assign sapply

【解决方案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 的实现在未来不会改变，从而破坏上述所有内容。

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

【讨论】：