尝试将match.fun
应用于其他函数中的函数时,我收到错误。
x <- matrix(rnorm(10*100), nrow=100) # data sample
descStats <- function(x, stats = c("n", "min", "max", "srange", "mean", "median", "sd")) {
n <- function(x, ...) sum(!is.na(x), ...)
srange <- function(x, ...) max(x, ...) - min(x, ...)
fun <- function(x) {
result <- vapply(stats, function(z) match.fun(z)(x, na.rm=TRUE), FUN.VALUE=numeric(1))
}
if (is.vector(x)) {
result <- fun(x)
}
if (is.matrix(x) || is.data.frame(x)) {
result <- t(apply(x, 2, fun))
}
return(result)
}
descStats(x)
## Error in get(as.character(FUN), mode = "function", envir = envir) :
## object 'n' of mode 'function' was not found
如果我在descStats函数之外定义n
和srange
,它可以正常工作。
n <- function(x, ...) sum(!is.na(x), ...)
srange <- function(x, ...) max(x, ...) - min(x, ...)
descStats2 <- function(x, stats = c("n", "min", "max", "srange", "mean", "median", "sd")) {
fun <- function(x) {
result <- vapply(stats, function(z) match.fun(z)(x, na.rm=TRUE), FUN.VALUE=numeric(1))
}
if (is.vector(x)) {
result <- fun(x)
}
if (is.matrix(x) || is.data.frame(x)) {
result <- t(apply(x, 2, fun))
}
return(result)
}
descStats2(x)
## n min max srange mean median sd
## [1,] 100 -2.303839 2.629366 4.933205 0.03711611 0.14566523 1.0367947
## [2,] 100 -1.968923 2.169382 4.138305 -0.03917503 0.02239458 0.9048509
## [3,] 100 -2.365891 2.424077 4.789968 -0.08012138 -0.23515910 1.0438133
## [4,] 100 -2.740045 2.127787 4.867832 0.03978241 0.15363449 0.9778891
## [5,] 100 -1.598295 2.603525 4.201820 0.23796616 0.16376239 1.0428915
## [6,] 100 -1.550385 1.684155 3.234540 -0.11114479 -0.09264598 0.8260126
## [7,] 100 -2.438641 3.268796 5.707438 0.02948100 -0.05594740 1.0481331
## [8,] 100 -1.716407 2.795340 4.511747 0.22463606 0.16296613 0.9555129
## [9,] 100 -2.359165 1.975993 4.335158 -0.33321888 -0.17580933 0.9784788
## [10,] 100 -2.139267 2.838986 4.978253 0.15540182 0.07803265 1.0149671
使用eval(call(FUN, args))
的另一种方式。例如。
descStats3 <- function(x, stats = c("n", "min", "max", "srange", "mean", "median", "sd")) {
n <- function(x, ...) sum(!is.na(x), ...)
srange <- function(x, ...) max(x, ...) - min(x, ...)
fun <- function(x) {
result <- vapply(stats, function(z) eval(call(z, x, na.rm=TRUE)), FUN.VALUE=numeric(1))
}
if (is.vector(x)) {
result <- fun(x)
}
if (is.matrix(x) || is.data.frame(x)) {
result <- t(apply(x, 2, fun))
}
return(result)
}
descStats3(x)
## n min max srange mean median sd
## [1,] 100 -2.303839 2.629366 4.933205 0.03711611 0.14566523 1.0367947
## [2,] 100 -1.968923 2.169382 4.138305 -0.03917503 0.02239458 0.9048509
## [3,] 100 -2.365891 2.424077 4.789968 -0.08012138 -0.23515910 1.0438133
## [4,] 100 -2.740045 2.127787 4.867832 0.03978241 0.15363449 0.9778891
## [5,] 100 -1.598295 2.603525 4.201820 0.23796616 0.16376239 1.0428915
## [6,] 100 -1.550385 1.684155 3.234540 -0.11114479 -0.09264598 0.8260126
## [7,] 100 -2.438641 3.268796 5.707438 0.02948100 -0.05594740 1.0481331
## [8,] 100 -1.716407 2.795340 4.511747 0.22463606 0.16296613 0.9555129
## [9,] 100 -2.359165 1.975993 4.335158 -0.33321888 -0.17580933 0.9784788
## [10,] 100 -2.139267 2.838986 4.978253 0.15540182 0.07803265 1.0149671
identical(descStats2(x), descStats3(x))
## [1] TRUE
为什么descStats
不起作用?
答案 0 :(得分:4)
这是一个范围问题。查看match.fun的代码,你会得到答案。
match.fun
范围是envir <- parent.frame(2)
get
范围位于envir = as.environment(-1) = parent.frame(1)
我认为我们无法通过环境作为论据。
一种解决方案是使用@nograpes(不安全)提供的get或者破解match.fun
并更改
envir <- parent.frame(2)
至envir <- parent.frame(1)
答案 1 :(得分:4)
编写自己的match.fun
版本相对容易(并且说明性好)。我调用了函数fget
来表明它是专为函数设计的get
版本,因此遵循函数的常规作用域规则。 (如果您不确定它们是什么,请考虑以下代码:c <- 10; c(c, 5)
)
#' Find a function with specified name.
#'
#' @param name length one character vector giving name
#' @param env environment to start search in.
#' @examples
#' c <- 10
#' fget("c")
fget <- function(name, env = parent.frame()) {
if (identical(env, emptyenv())) {
stop("Could not find function called ", name, call. = FALSE)
}
if (exists(name, env, inherits = FALSE) && is.function(env[[name]])) {
env[[name]]
} else {
fget(name, parent.env(env))
}
}
实现是一个简单的递归函数:基本情况是emptyenv()
,每个环境的最终祖先,并且对于父级堆栈中的每个环境,我们检查是否有一个名为{的对象{1}}存在,并且它是一个函数。
它适用于@nograpes提供的简单测试用例,因为环境默认为调用环境:
name
答案 2 :(得分:1)
由于我还不完全理解的原因,如果您使用get
代替match.fun
,一切正常。
x <- matrix(rnorm(10*100), nrow=100) # data sample
descStats <- function(x, stats = c("n", "min", "max", "srange", "mean", "median", "sd")) {
n <- function(x, ...) sum(!is.na(x), ...)
srange <- function(x, ...) max(x, ...) - min(x, ...)
fun <- function(x) {
# get added here.
result <- vapply(stats, function(z) get(z)(x, na.rm=TRUE), FUN.VALUE=numeric(1))
}
if (is.vector(x)) {
result <- fun(x)
}
if (is.matrix(x) || is.data.frame(x)) {
result <- t(apply(x, 2, fun))
}
return(result)
}
descStats(x)