match.fun在函数内定义的函数中提供错误

尝试将match.fun应用于在其他函数中定义的函数时出错。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

如果我定义n和srange外descStats的功能，它工作正常。

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不起作用？

来源

2013-01-06 Artem Klevtsov

我喜欢重复的例子，但更小例子是'乐趣< - 函数（X ）n < - sum; match.fun（ 'N'）（X）'。以防万一其他人正在通过这个看。 – nograpes

@nograpes：我同意但我决定从我的工作中带来真正的功能。 –

这是一个范围问题。查看match.fun的代码，你会得到答案。

match.fun范围是envir <- parent.frame(2)

get范围在envir = as.environment(-1) = parent.frame(1)

我认为，我们不能通过ENVIR作为参数。一种解决方案是使用由@nograpes（不安全）获得尽可能呈现或破解match.fun和改变

envir <- parent.frame(2)到envir <- parent.frame(1)

来源

2013-01-06 16:24:41 agstudy

感谢您的澄清。 –

由于我还不完全了解的原因，如果您使用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)

来源

2013-01-06 16:10:13 nograpes

这是比较容易的（和说明）编写自己的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()，每个环境的最终祖先，并为每个环境沿着父母堆栈，我们检查是否存在一个名为name的对象，并且它是一个函数。

它的工作原理由@nograpes提供，因为环境默认调用环境的简单的测试案例：

fun <- function(x) { 
    n <- sum 
    fget('n')(x) 
} 
fun(10) 
# [1] 10

来源

2013-01-09 14:42:53 hadley

match.fun在函数内定义的函数中提供错误

回答

相关问题