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