Defining a new class of functions in R

Question

So I'm changing the class of some functions that I'm building in R in order to add a description attribute and because I want to use S3 generics to handle everything for me. Basically, I have a structure like

foo <- function(x) x + 1

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

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

and then I do stuff like

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

This works fine, but it's not that elegant. I'm wondering if it is possible to define a new class of functions such that instances of this class can be defined in a syntax similar to the function syntax. In other words, is it possible to define addFunction such that foo is generated in the following way:

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

(or something similar, I have no strong feelings about where the attribute should be added to the function)?

Thanks for reading!

---

Update: I have experimented a bit more with the idea, but haven't really reached any concrete results yet - so this is just an overview of my current (updated) thoughts on the subject:

I tried the idea of just copying the function()-function, giving it a different name and then manipulating it afterwards. However, this does not work and I would love any inputs on what is happening here:

> 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"

As function() is a primitive function, I tried looking at the C-code defining it for more clues. I was particularly intrigued by the error message from the function2(x) call. The C-code underlying function() is

/* 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;
  }

and from this, I conclude that for some reason, at least two of the four arguments call, op, args and rho are now required. From the signature of do_function() I am guessing that the four arguments passed to do_function should be a call, a promise, a list of arguments and then maybe an environment. I tried a lot of different combinations for function2 (including setting up to two of these arguments to NULL), but I keep getting the same (new) error message:

> 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"

This error message is returned from the C-function CheckFormals(), which I also looked up:

/* 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\""));
  }

I'm not fluent in C at all, so from here on I'm not quite sure what to do next.

So these are my updated questions:

• Why do function and function2 not behave in the same way? Why do I need to call function2 using a different syntax when they are deemed identical in R?
• What are the proper arguments of function2 such that function2([arguments]) will actually define a function?

Answer 1

Some keywords in R such as if and function have special syntax in the way that the underlying functions get called. It's quite easy to use if as a function if desired, e.g.

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

is equivalent to

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

function is trickier. There's some help on this at a previous question.

For your current problem here's one solution:

# 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