2

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働かないのですか?

4

3 に答える 3

5

の独自のバージョンを作成するのは比較的簡単です(そして説明的です)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-09T14:42:53.930 に答える
4

スコープの問題です。match.funのコードを見ると、答えが得られます。

match.funスコープは envir <- parent.frame(2)

getスコープは envir = as.environment(-1) = parent.frame(1)

envirを引数として渡すことはできないと思います。1つの解決策は、@ nograpes(安全ではない)によって提示されたgetを使用するか、ハッキングmatch.funして変更することです。

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

于 2013-01-06T16:24:41.120 に答える
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)
于 2013-01-06T16:10:13.833 に答える