Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Why doesn't lapply work on S4 objects which have an as.list.default method?

Tags:

class

r

lapply

s4

Suppose I have a vector-like S4 class:

.MyClass <- setClass("MyClass", representation(a="numeric", b="character"))

setMethod("[", c("MyClass", "numeric", "missing"), function(x, i, j, ...) {
  do.call(initialize, c(x, sapply(slotNames(x), function(y) slot(x, y)[i],
          simplify=FALSE)))
})

setMethod("length", "MyClass", function(x) length(x@a))

And say I have also defined methods for as.list and as.list.default:

setGeneric("as.list")
setMethod("as.list", "MyClass",
          function(x) lapply(seq_along(x), function(i) x[i]))
setGeneric("as.list.default")
setMethod("as.list.default", "MyClass",
          function(x) lapply(seq_along(x), function(i) x[i]))

Now given an object of this class, myobj:

myobj <- .MyClass(a=1:4, b=letters[1:4])

When I use lapply, it complains:

> lapply(myobj, function(i) rep(i@b, i@a))
Error in as.list.default(X) : 
  no method for coercing this S4 class to a vector

But if I use as.list.default, the function gives the desired output:

> lapply(as.list.default(myobj), function(i) rep(i@b, i@a))
[[1]]
[1] "a"

[[2]]
[1] "b" "b"
...

Why does lapply not work even though I have defined a method for as.list.default for the class?

Obviously I can manually define a lapply method for the class and it will work fine (below), but I was wondering where the error is actually being encountered. Why is lapply attempting to coerce my object into a vector even though the function it is calling should be turning the object into a list?

setGeneric("lapply")
setMethod("lapply", c("MyClass", "function"), function(X, FUN, ...) {
  lapply(as.list(X), FUN, ...)
})
lapply(myobj, function(i) rep(i@b, i@a))
like image 897
Will Beason Avatar asked Sep 27 '14 22:09

Will Beason


1 Answers

From the ?Methods help page, a workable strategy seems to be

#same
.MyClass <- setClass("MyClass", representation(a="numeric", b="character"))

setMethod("[", c("MyClass", "numeric", "missing"), function(x, i, j, ...) {
  do.call(initialize, c(x, sapply(slotNames(x), function(y) slot(x, y)[i],
          simplify=FALSE)))
})

setMethod("length", "MyClass", function(x) length(x@a))

#different
as.list.MyClass <-function(x) {
    lapply(seq_along(x), function(i) x[i])
}
setMethod("as.list", "MyClass", as.list.MyClass)

#test
myobj <- .MyClass(a=1:4, b=letters[1:4])
lapply(myobj, function(i) rep(i@b, i@a))

# [[1]]
# [1] "a"
# 
# [[2]]
# [1] "b" "b"
# 
# [[3]]
# [1] "c" "c" "c"
# 
# [[4]]
# [1] "d" "d" "d" "d"
like image 162
MrFlick Avatar answered Oct 25 '22 17:10

MrFlick