在 R 中定义一类新的函数

Question

所以我正在更改我在 R 中构建的一些函数的类，以便添加描述属性，并且因为我想使用 S3 泛型来为我处理所有事情。基本上，我有一个类似的结构

foo <- function(x) x + 1

addFunction <- function(f, description) {
    class(f) <- c("addFunction", "function")
    attr(f, "description") <- description
    f
}

foo <- addFunction(foo, "Add one")

然后我会做类似的事情

description <- function(x) UseMethod("description")
description.default <- function(x) deparse(substitute(x))
description.addFunction <- function(x) attr(x, "description")

这很好用，但不是那么优雅。我想知道是否可以定义一个新的函数类，以便可以用类似于function 语法的语法定义此类的实例。换句话说，是否可以定义addFunction，使得foo以如下方式生成：

foo <- addFunction(description = "Add one", x) {
    x + 1
}

（或类似的东西，我对属性应该添加到函数的哪个位置没有强烈的感觉）？

感谢阅读！

---

更新：我对这个想法进行了更多尝试，但还没有真正达到任何具体结果 - 所以这只是我当前（更新）对该主题的想法的概述：

我尝试了复制function()-函数的想法，给它一个不同的名称，然后再对其进行操作。但是，这不起作用，我希望能对这里发生的事情提供任何意见：

> function2 <- `function`
> identical(`function`, function2)
[1] TRUE
> function(x) x
function(x) x
> function2(x) x
Error: unexpected symbol in "function2(x) x"
> function2(x)
Error: incorrect number of arguments to "function"

由于function() 是一个原始函数，我尝试查看定义它的C 代码以获取更多线索。我对来自function2(x) 调用的错误消息特别感兴趣。 function() 底层的 C 代码是

/* Declared with a variable number of args in names.c */
  SEXP attribute_hidden do_function(SEXP call, SEXP op, SEXP args, SEXP rho)
{
  SEXP rval, srcref;

  if (TYPEOF(op) == PROMSXP) {
    op = forcePromise(op);
    SET_NAMED(op, 2);
  }
  if (length(args) < 2) WrongArgCount("function");
  CheckFormals(CAR(args));
  rval = mkCLOSXP(CAR(args), CADR(args), rho);
  srcref = CADDR(args);
  if (!isNull(srcref)) setAttrib(rval, R_SrcrefSymbol, srcref);
  return rval;
  }

据此，我得出结论，由于某种原因，现在需要 call、op、args 和 rho 四个参数中的至少两个。从do_function() 的签名我猜测传递给do_function 的四个参数应该是一个调用、一个承诺、一个参数列表，然后可能是一个环境。我为 function2 尝试了很多不同的组合（包括将其中两个参数设置为 NULL），但我不断收到相同的（新）错误消息：

> function2(call("sum", 2, 1), NULL, list(x=NULL), baseenv())
Error: invalid formal argument list for "function"
> function2(call("sum", 2, 1), NULL, list(x=NULL), NULL)
Error: invalid formal argument list for "function"

这个错误信息是从我也查过的C函数CheckFormals()返回的：

/* used in coerce.c */
  void attribute_hidden CheckFormals(SEXP ls)
{
  if (isList(ls)) {
    for (; ls != R_NilValue; ls = CDR(ls))
      if (TYPEOF(TAG(ls)) != SYMSXP)
        goto err;
    return;
  }
  err:
    error(_("invalid formal argument list for \"function\""));
  }

我完全不会流利地使用 C，所以从现在开始我不太确定下一步该做什么。

所以这些是我更新的问题：

• 为什么function 和function2 的行为方式不同？为什么 我是否需要使用不同的语法调用function2 在 R 中被视为相同？
• function2 的正确参数是什么 这样function2([arguments]) 会真正定义一个函数吗？

Answer 1

R 中的一些关键字，例如if 和function，在调用底层函数的方式上具有特殊的语法。如果需要，可以很容易地将 if 用作函数，例如

`if`(1 == 1, "True", "False")

等价于

if (1 == 1) {
  "True"
} else {
  "False"
}

function 比较棘手。 a previous question 有一些帮助。

对于您当前的问题，这里有一个解决方案：

# Your S3 methods
description <- function(x) UseMethod("description")
description.default <- function(x) deparse(substitute(x))
description.addFunction <- function(x) attr(x, "description")

# Creates the pairlist for arguments, handling arguments with no defaults
# properly. Also brings in the description
addFunction <- function(description, ...) {
  args <- eval(substitute(alist(...)))
  tmp <- names(args)
  if (is.null(tmp)) tmp <- rep("", length(args))
  names(args)[tmp==""] <- args[tmp==""]
  args[tmp==""] <- list(alist(x=)$x)
  list(args = as.pairlist(args), description = description)
}

# Actually creates the function using the structure created by addFunction and the body
`%{%` <- function(args, body) {
  stopifnot(is.pairlist(args$args), class(substitute(body)) == "{")
  f <- eval(call("function", args$args, substitute(body), parent.frame()))
  class(f) <- c("addFunction", "function")
  attr(f, "description") <- args$description
  f
}

# Example. Note that the braces {} are mandatory even for one line functions

foo <- addFunction(description = "Add one", x) %{% {
  x + 1
}

foo(1)
#[1] 2