Reference Class with custom field classes in R?

问题:

I would like to use a custom reference class inside another reference class, but this code fails:

nameClass <- setRefClass("nameClass", fields = list(first = "character",
                                                last = "character"),
                     methods = list(
                       initialize = function(char){
                         chunks <- strsplit(char,"\\.")
                         first <<- chunks[[1]][1]
                         last <<- chunks[[1]][2]
                       },
                       show = function(){
                         cat("Special Name Class \n:")
                         cat("First Name:")
                         methods::show(first)
                         cat("Last Name:")
                         methods::show(last)
                       }
                       ))
# this works fine
nameClass$new("tyler.durden")

When I try to add a second class that has a field of class nameClass this class cannot be initiated.

personClass <- setRefClass("personClass", fields = list(fullname = "nameClass",
                                                    occupation = "character"),
                       methods = list(
                         initialize = function(Obj){
                           nm  <- deparse(substitute(Obj))
                           fullname <<- nameClass$new(nm)
                           occupation <<- Obj
                         }))

this just returns:

 Error in strsplit(char, "\\.") : 
 argument "char" is missing, with no default

I could imagine a solution where nameClass is an S4 class but I reading a little made me kind of afraid to mix S4 and reference classes. Am I missing somthing or should I simply use an S4 classes when I want to define this particular name field more exactly than just 'character'?

I also found this thread with a promising title but could not figure out how this could solve my problem.

回答1:

This is a variation of a common issue in the S4 system, where for inheritance to work a call to new with zero arguments has to work. This is because of the way inheritance is implemented, where the base class is instantiated and then populated with values from the derived class. To instantiate the base class requires creating it without any arguments. That you have a problem is illustrated with

> nameClass()
Error in .Internal(strsplit(x, as.character(split), fixed, perl, useBytes)) : 
  'x' is missing

and the solution is to provide a default argument in your initialize method

initialize=function(char=charcter()) { <...> }

or to otherwise arranging (e.g., by testing missing(char) in the body of initialize) for a no-argument call to the constructor to work.

Probably programming best practice would dictate that the initialize method takes a ... argument and has callSuper() in its body, so that derived classes can take advantage of base class (e.g., field assignment) functionality. To avoid problems with inadvertent matching of unnamed arguments, I think the signature should probably end up built around a template that looks like

initialize(..., char=character()) { callSuper(...) }

This scheme relies on a suitable definition of an 'empty' nameClass. The following probably has too much opinion and change of perspective to be immediately useful, but... It's tempting to think of nameClass as a 'row' in a data frame, but it's better (because R works best on vectors) to think of it as describing columns. With this in mind a reasonable representation of an 'empty' nameClass is where the first and last fields are each of length 0. Then

nameClass <- setRefClass("nameClass",
    fields = list(first = "character", last = "character"),
    methods = list(
      initialize = function(..., char=character()){
          if (length(char)) {
              names <- strsplit(char, ".", fixed=TRUE)
              .first <- vapply(names, "[[", character(1), 1)
              .last <- vapply(names, "[[", character(1), 2)
          } else {
              .first <- character()
              .last <- character()
          }
          callSuper(..., first=.first, last=.last)
      }, show = function(){
          .helper <- function(x)
              sprintf("%s%s", paste(sQuote(head(x)), collapse=", "),
                      if (length(x) > 6) ", ..." else "")
          cat("Special Name Class (n = ", length(first), ")\n", sep="")
          cat("First names:", .helper(first), "\n")
          cat("Last names:", .helper(last), "\n")
      }))

with test cases like

> nameClass()
Special Name Class (n = 0)
First names:  
Last names:  
> nameClass(char="Paul.Simon")
Special Name Class (n = 1)
First names: 'Paul' 
Last names: 'Simon' 
> nameClass(char=c("Paul.Simon", "Frank.Sinatra"))
Special Name Class (n = 2)
First names: 'Paul', 'Frank' 
Last names: 'Simon', 'Sinatra' 
> nameClass(char=paste(LETTERS, letters, sep="."))
Special Name Class (n = 26)
First names: 'A', 'B', 'C', 'D', 'E', 'F', ... 
Last names: 'a', 'b', 'c', 'd', 'e', 'f', ... 

The derived class might be defined as

personClass <- setRefClass("personClass",
    fields = list(fullname = "nameClass", occupation = "character"),
    methods = list(
      initialize = function(..., fullname=nameClass(),
                            occupation=character()) {
          callSuper(..., fullname=fullname, occupation=occupation)
      }))

with test cases like

personClass()
personClass(fullname=nameClass())
personClass(fullname=nameClass(), occupation=character())
personClass(fullname=nameClass(char="some.one"), occupation="job")

回答2:

It seems that this is because you do not have a default constructor for your "nameClass":

nameClass$new()
Error in strsplit(char, "\\.") : 
  argument "char" is missing, with no default

If you modify your nameClass like this:

nameClass <- setRefClass("nameClass", fields = list(first = "character",
                                                    last = "character"),
                         methods = list(
                           initialize = function(s = NULL) {
                             if (!is.null(s) && nzchar(s)) {
                               chunks <- strsplit(s,"\\.")
                               first <<- chunks[[1]][1]
                               last <<- chunks[[1]][2]
                             }
                           },
                           show = function(){
                             cat("Special Name Class \n:")
                             cat("First Name:")
                             methods::show(first)
                             cat("Last Name:")
                             methods::show(last)
                           }
                         ))

Then:

nameClass$new()
Special Name Class 
:First Name:character(0)
Last Name:character(0)

and your personClass is now functional (yet the initialize method is quite odd):

personClass$new("tyler.durden")
Reference class object of class "personClass"
Field "fullname":
Special Name Class 
:First Name:[1] "\"tyler"
Last Name:[1] "durden\""
Field "occupation":
[1] "tyler.durden"