以下函数的目的是允许更轻松地进行自引用分配。 (如此处建议: 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))
    }
    

    最佳答案

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

    以下内容仅适用于 sapply,因此它只能部分回答您的问题,但它确实列出了您可以采取的策略。正如我在之前的评论中指出的那样,要使这个强大的功能非常困难,但我可以在 sapply 调用的特定上下文中回答 1 和 2

  • 使用 sys.calls 获取跟踪堆栈
  • 使用 sys.framesys.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 遇到的问题

    10-07 13:00