S4 class [ (subset) inheritance with additional arguments

Question

This is an extension of Using callNextMethod() within accessor function in R.

Update 2017-03-25: To illustrate how this only fails when loading the methods, but not when it's in a built package, I created a dummy package: https://github.com/zkamvar/inheritest#readme

Basic problem:

I have a class bar that inherits another class foo, and both of them have additional arguments for the [ method. The method for foo works consistently, but the method for bar fails after the first use.

Error and Traceback:

Error in callNextMethod(x, i, j, ..., drop): bad object found as method (class "function")

4: stop(gettextf("bad object found as method (class %s)",  dQuote(class(method))), 
   domain = NA)
3: callNextMethod(x, i, j, ..., drop) at #9
2: .local(x, i, j, ..., drop = drop)
1: BAR["x"]

Further details:

I have a package that implements a class that depends on a class from another package. When the packages are built, everything works fine, but when my package is simply loaded (using devtools::load_all(".")), I get the behavior below.

Minimum Working Example:

foo <- setClass("foo", representation(x = "numeric", y = "numeric"))
bar <- setClass("bar", representation(distance = "numeric"), contains = "foo")

setMethod(f = "[", signature = signature(x = "foo", i = "ANY", j = "ANY", drop = "ANY"), 
  definition = function(x, i, j, ..., foo = TRUE, drop = FALSE) {
    if (foo) 
      message("FOOOOOOO")
    if (i == "x") {
      return(x@x)
    } else {
      if (i == "y") {
        return(x@y)
      }
    }
  })
#> [1] "["

setMethod(f = "[", signature = signature(x = "bar", i = "ANY", j = "ANY", drop = "ANY"), 
  definition = function(x, i, j, ..., bar = TRUE, drop = FALSE) {
    if (bar) 
      message("BAAAAAAR")
    if (i == "distance") {
      return(x@distance)
    } else {
      callNextMethod(x, i, j, ..., drop)
    }
  })
#> [1] "["

FOO <- new("foo", x = 1, y = 4)
BAR <- new("bar", x = 1, y = 4, distance = 3)
FOO["x"]
#> FOOOOOOO
#> [1] 1
BAR["x"]
#> BAAAAAAR
#> FOOOOOOO
#> [1] 1
FOO["x"]
#> FOOOOOOO
#> [1] 1
BAR["distance"]
#> BAAAAAAR
#> [1] 3
BAR["x"]  # fails
#> BAAAAAAR
#> Error in callNextMethod(x, i, j, ..., drop): bad object found as method (class "function")
BAR["x", foo = FALSE]
#> BAAAAAAR
#> [1] 1

Note: when I passed this through reprex, The first and last calls to BAR resulted in errors as well, but I am showing what I experience in an interactive session. I am using R version 3.3.3

Answer 1

This is because callNextMethod() is not smart enough to handle methods on primitives with augmented formals. I've fixed it and will commit to trunk soon.

Answer 2

Here's a partial answer: it is to do with "[" specifically. Here is some working code, that replaces the '[' method with a 'bat' method. It works fine for me:

foo <- setClass("foo", representation(x = "numeric", y = "numeric"))
bar <- setClass("bar", representation(distance = "numeric"), contains = "foo")

bat <- function (x, i, j, ..., drop = FALSE) message('in bat')
setGeneric('bat')
setMethod(f = "bat", signature = signature(x = "foo"), 
  definition = function(x, i, j, ..., foo = TRUE, drop = FALSE) {
    if (foo) 
      message("FOOOOOOO")
    if (i == "x") {
      return(x@x)
    } else {
      if (i == "y") {
        return(x@y)
      }
    }
  })
#> [1] "["

setMethod(f = "bat", signature = signature(x = "bar"), 
  definition = function(x, i, j, ..., bar = TRUE, drop = FALSE) {
    if (bar) 
      message("BAAAAAAR")
    if (i == "distance") {
      return(x@distance)
    } else {
      callNextMethod(x, i, j, ..., drop)
    }
  })

FOO <- new("foo", x = 1, y = 4)
BAR <- new("bar", x = 1, y = 4, distance = 3)
bat(FOO, 'x')
bat(BAR, 'distance')
bat(BAR, 'x')

And now:

bat(FOO, 'x')
FOOOOOOO
[1] 1
bat(BAR, 'x')
BAAAAAAR
FOOOOOOO
[1] 1
bat(BAR, 'distance')
BAAAAAAR
[1] 3
bat(BAR, 'x')
BAAAAAAR
FOOOOOOO
[1] 1

So, I think this is something to do with the interaction of S4 dispatch and ['s own dispatching... and solutions? I have none, except to avoid S4 like the plague it seems to be. Maybe R-devel can help. It's possible this is a genuine R bug, given that the code only breaks for [.

Answer 3

The issue has likely to do with the fact that [ is a primitive, and primitives are dealt with differently when using S4. Digging into callNextMethod shows that the callstack isn't analyzed correctly in the case that the method has different arguments compared to the generic for that primitive function. If you drop the argument bar from the method definition, dispatching works correctly.

That said, there is another workaround that doesn't require you to choose another function name. I add an extra function as.foo and recall the generic after converting to a foo object:

setGeneric("as.foo", function(x)standardGeneric("as.foo"))
setMethod("as.foo", signature = "bar",
          function(x)
            new("foo", x = x@x, y = x@y))

setMethod(f = "[", signature = signature(x = "bar", i = "ANY", j = "ANY", drop = "ANY"), 
          definition = function(x, i, j, ..., bar = TRUE, drop = FALSE) {
            if (bar) 
              message("BAAAAAAR")
            if (i == "distance") {
              return(x@distance)
            } else {
               x <- as.foo(x)
               callGeneric()
            }
          }
)

This way you circumvent the hiccup in dispatching, and all the code that used to fail now works

FOO["x"]
#> FOOOOOOO
#> [1] 1
BAR["x"]
#> BAAAAAAR
#> FOOOOOOO
#> [1] 1
BAR["distance"]
#> BAAAAAAR
#> [1] 3
BAR["x"]  
#> BAAAAAAR
#> FOOOOOOO
#> [1] 1
BAR["x", foo = FALSE]
#> BAAAAAAR
#> [1] 1