如何编写可以将向量或公式作为第一个参数的 R 函数？答案

【问题标题】：How to write R function that can take either a vector or formula as first argument?如何编写可以将向量或公式作为第一个参数的 R 函数？
【发布时间】：2014-04-13 23:42:09
【问题描述】：

我正在编写一个函数，我希望能够将向量和公式作为第一个参数。如果是向量，我会做一些单变量计算，如果是公式，我会通过第二个变量分析第一个变量（第二个变量总是一个因素）。

这是我当前的代码：

fun = function(formula,data) {

  if (class(with(data,formula))=="formula") {
    mod = model.frame(formula,data)
    n.group=names(mod)[2] 
    group <- eval(parse(text=paste("mod$",n.group,sep=""))) #x
    response <- model.response(mod) # y
    return(table(response,group))
  }

  else {
    return(table(with(data,formula)))
  }
}

data(iris)

fun(Sepal.Length~Species,iris) # works correctly
fun(Sepal.Length,iris) # returns an error

返回值仅作说明。

干杯！

【问题讨论】：

with(fun(Sepal.Length, iris)), "Error in eval(expr, envir, enclos) : object 'Sepal.Length' not found" 应该很好地表明了错误。
对不起，with(iris, fun(Sepal.Length, iris))

标签： r function

【解决方案1】：

试试这个：

fun.formula <- function(formula, data) {
  mod = model.frame(formula, data)
  n.group <- names(mod)[2] 
  group <- eval(parse(text=paste("mod$",n.group,sep=""))) #x
  response <- model.response(mod) # y
  table(response, group)
}

fun <- function(formula, data) {
    ret <- try( table(eval(substitute(formula), data), silent = TRUE)
    if (inherits(try, "try-error)) fun.formula(formula, data) else ret
}

# tests
fun(Sepal.Length ~ Species, iris)
fun(Sepal.Length, iris)

也就是说，这是一个相当不寻常的接口，相反，最好通过将其名称作为字符串传递来指定公式是变量的情况，在这种情况下，可以使用更常见的 S3 实现：

fun2 <- function(formula, data, ...) UseMethod("fun2")
fun2.formula <- fun.formula
fun2.character <- function(formula, data) table(data[[formula]])

# tests
fun2(Sepal.Length ~ Species, iris)
fun2("Sepal.Length", iris) # with this approach use a character string

已修订现在我们使用try 并添加了 S3 方法。

【讨论】：

感谢您的回复 - 它把我推向了正确的方向！

【解决方案2】：

理想情况下，我会使用 S3 方法解决这个问题，但我不知道该怎么做。以下完成了工作：

fun <- function(x,data) {
  mod = try(model.frame(x,data),silent=T)
  if (inherits(mod, "try-error")) {
    x=data[,deparse(substitute(x))]
    return(table(x))
  }
  else {
    mod = model.frame(x,data)
    n.group=names(mod)[2] 
    group <- eval(parse(text=paste("mod$",n.group,sep=""))) #x
    response <- model.response(mod) # y
    return(table(response,group))    
  }
}

fun(Sepal.Length~Species,iris) # works correctly
fun(Sepal.Length,iris) # works!

【讨论】：