r - NSE如何处理及使用方法

Question

看看这个“简单”的功能：

test <- function(x,...){
    UseMethod("test",x)
}

test.default<-function(x,y,data){
  message("default")
  print(deparse(substitute(x)))
  print(deparse(substitute(y)))
  print(deparse(substitute(data)))
  print(match.call())
}

test.formula <- function(x,...){
  message("formula")
  print(deparse(substitute(x)))
  print(match.call())
}

一切都很好

data(iris)
test.formula(Sepal.Length~Petal.Width,iris)
test.default(Sepal.Length,Petal.Width,iris)
test(Sepal.Length~Petal.Width,iris)

除了这个：

test(Sepal.Length,Petal.Width,iris)

由于 NSE ：object 'Sepal.Length' not found

任何想法 ？

Answer 1

想出解决方案并不容易，因为你没有在这里指定你的最终游戏，但我认为我同意42-S3 调度可能不是工具。您可能正在寻找lazyeval::lazy_dots

library("lazyeval")
tezt <- function(data, ... ){
  dots <- lazyeval::lazy_dots(...)
  dots
}

你给你...的lazy_dots，然后你就可以处理它。

str( tezt(iris, Sepal.Length, Petal.Width) )
#> List of 2
#>  $ :List of 2
#>   ..$ expr: symbol Sepal.Length
#>   ..$ env :<environment: 0x7fedb11bb720> 
#>   ..- attr(*, "class")= chr "lazy"
#>  $ :List of 2
#>   ..$ expr: symbol Petal.Width
#>   ..$ env :<environment: 0x7fedb11bb720> 
#>   ..- attr(*, "class")= chr "lazy"
#>  - attr(*, "class")= chr "lazy_dots"

或者：

str( tezt(iris, Sepal.Length ~ Petal.Width) )
#> List of 1
#>  $ :List of 2
#>   ..$ expr: language Sepal.Length ~ Petal.Width
#>   ..$ env :<environment: 0x7fedb11bb720> 
#>   ..- attr(*, "class")= chr "lazy"
#>  - attr(*, "class")= chr "lazy_dots"

此外，您可能对hadley/rlang 感兴趣

Answer 2

我会更满意：

require(ggplot2)

test <- aes
test(Sepal.Length, Petal.Width, iris)
#    
* x -> Sepal.Length
* y -> Petal.Width
*   -> iris

使用 S3 调度的问题是没有价值，因此没有“裸”的类Sepal.Length。该aes函数不使用 S3 调度，而是立即转到match.call()[-1].

Answer 3

我找到了一个解决方案，但一个棘手的...

tryCatch.W.E <- function(expr)
   {
         W <- NULL
         w.handler <- function(w){ # warning handler
        W <<- w
        invokeRestart("muffleWarning")
           }
         list(value = withCallingHandlers(tryCatch(expr, error = function(e) e),
                                                                 warning = w.handler),
                     warning = W)
     }

test <- function(x, ...) {

  if (inherits(tryCatch.W.E(x)$value,"error")) { 

    return(test.default(x,...))
    }

  UseMethod("test", x)
}

test.default <- function(x, y, data) {
  message("default")
  print(deparse(substitute(x)))
  print(deparse(substitute(y)))
  print(deparse(substitute(data)))
  print(match.call())
}

test.formula <- function(x, ...) {
  message("formula")
  print(deparse(substitute(x)))
  print(match.call())
}
test.formula(Sepal.Length ~ Petal.Width, iris)
test.default(Sepal.Length, Petal.Width, iris)
test(Sepal.Length ~ Petal.Width, iris)

现在可以了：

test(Sepal.Length, Petal.Width, iris)