R:如何重载 + 运算符以调用将函数添加到 R6 class 的方法?

R: How to overload + operator to call a method which adds a function to an R6 class?

我的目标是重载 + 运算符以便调用 R6 object 上的方法。这是一个带有 class aclass 的 R6 对象的玩具示例,它有一个方法 add_function(foo) 来存储一些任意函数。

我想用 + fooggplot2's +.gg or +(e1,e2). I checked the ggplot2 github code 的样式替换对 add_function(foo) 的调用,但无法弄清楚。

这是一个 R6 对象,我们可以向其添加任意函数

library(R6)
# The class (called aclass) looks like so:
Aclass <- R6Class("aclass",
  public = list(
    fun = NULL,
    x = NULL,
    initialize = function(x) {
      self$x <- x
      return(invisible(self))
    },
    # this is the function adding part
    add_fun = function(fun) {
      self$fun <- substitute(fun)
    },
    # and here we execute the functions
    do_fun = function() {
      return(eval(self$fun)(self$x))
}))

# Say, we want to add this function to an aclass object
foo <- function(x) mean(x, na.rm=TRUE)

这个有效

# Instantiate class
my_class <- Aclass$new(c(0,1,NA))
# Add the function
my_class$add_fun(function(x) mean(x, na.rm=TRUE))
# my_class$add_fun(foo) # this also works
# Execute the function - beautiful - returns 0.5
my_class$do_fun()

这失败了

我的目标是做与上面相同的事情,即将 foo 添加到对象,但现在通过重载 + 运算符以更好的方式完成工作

# Let's try to overload the + operator
`+.aclass` <- function(e1, e2) {
  return(e1$add_fun(e2))
}

# option 1
my_class <- Aclass$new(c(0,1,NA)) + foo
# fails
# Looking at my class we get
my_class
# > my_class                                       
# e2

# option 2 <--- this is my end goal
my_class <- Aclass$new(c(0,1,NA)) + mean(x, na.rm=TRUE)
# also fails because then R tries to execute the function
# > Error in mean(x, na.rm = TRUE) : Object 'x' not found

# Note: in this case, the custom +.aclass is not even called,
# but R calls the normal + method I think

我不确定如何解决这个问题或者是否真的可行...

感谢您的帮助!

通过删除 add_fun 函数中的 substitute 并返回 self(因为您正在将其影响到一个新对象)

    # this is the function adding part
    add_fun = function(fun) {
      self$fun <- fun
      self
    },

它将与

一起使用
  • my_class <- Aclass$new(c(0,1,NA)) + foo
    还有
  • my_class <- Aclass$new(c(0,1,NA)) + function(x) mean(x,na.rm=TRUE)

对于您的目标案例,它会更难

  • + mean(x, na.rm=TRUE)

甚至对 ggplot2 函数进行求值(例如,labs(x="title") 将求值为 class label 的对象,添加到 ggplot 最终将调用函数 ggplot_add.labels)

通过使用公式符号稍微调整您的目标案例,它可以得到解决

  • + ~mean(x, na.rm=TRUE)

使用此代码

`+.aclass` <- function(e1, e2) {
  se2 <- substitute(e2)

  # detect formula
  if(is.call(se2) && as.character(se2)=="~") {
    # build template function
    e3 <- substitute(function(x) y)
    # replace y in template by formula body
    e3[[3]] <- se2[[2]]
    # use our templated formula function
    e2 <- e3
  }
  e1$add_fun(e2)
  e1
}

最后使用 rlang 中可用的更高级别的函数,我们可以将其简化为

`+.aclass` <- function(e1, e2) {
  e1$add_fun(rlang::as_function(e2))
  e1
}

请注意,类似函数的公式需要 .x 而不是 x