获取match.call（）以使用*apply&；普利尔？（re：递归引用数据帧）

以下功能的目的是更方便地进行自参考作业。（如此处所示：）

因此

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

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

也许在selfAssign中有类似于

sys.parent（n）

（我试过了，要么我没有弄好，要么它不起作用）

如有任何建议，将不胜感激

---

---

功能 这些函数是自我分配的包装器，是将在

*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)
}

---

注意，我不支持这种类型的东西，但我支持理解R是如何工作的，这样你就可以做这些东西，如果你想做的话

以下内容仅适用于

sapply

，因此它只能部分回答您的问题，但它确实列出了您可以采取的策略。正如我在前面的评论中所指出的那样，要使这一功能变得强大是非常困难的，但我可以在

sapply

调用的特定上下文中回答1和2

使用

sys.calls

获取跟踪堆栈

使用

sys.frame

和

sys.parents

获得适当的评估环境

一种非健壮的示例性实现，使用您想要的策略类型将列表中的所有向量转换为NAs：

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
# ...

---

get\u sapply\u调用同样，我意识到
df[is.na（df）]通常的警告：R是一种传递值语言，你试图违背自然，修改传递给函数的对象，而不必用函数的输出重新分配它们，也就是说，你想做
f（x）
而不是
x，您可能遇到与基本
调用功能相同的困难。从文档中可以看出：“Recall”作为函数参数传递时无法正常工作，例如，传递到“apply”函数系列..@flodel，感谢您指出Recall。你可能是对的，有一个类似的原因。至于通常的警告，也谢谢你。这当然很难，但我愿意听到更多关于潜在危险和陷阱的信息。这里的特殊问题（…在不存在的情况下用于SIUTION）是，您正在将sapply发出的调用与您的函数进行匹配，该调用包括
…
，但您的函数没有。有很多方法可以解决这个问题，但更大的问题是，即使您匹配调用，sapply使用的变量名也是
X
，这可能不是您要设置的变量名。您必须在整个调用堆栈中寻找实际的变量名。对于非常具体的实例（例如sapply），您可能可以这样做，但这几乎不可能概括。
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))
}

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
# ...