Reference Class with custom field classes in R?

久未见 提交于 2019-12-03 03:41:56

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

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"
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!