Ссылочный класс с пользовательскими полями классов в R?

Question

Я хотел бы использовать пользовательский ссылочный класс внутри другого ссылочного класса, но этот код не работает:

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

Когда я пытаюсь добавить второй класс, который имеет поле класса nameClass этот класс не может быть инициирован.

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

это просто возвращает:

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

Я мог бы представить себе решение, в котором nameClass - это класс S4, но, прочитав немного, я немного боялся смешивать классы S4 и эталонные. Я что-то упускаю или я должен просто использовать классы S4, когда я хочу определить это конкретное поле имени более точно, чем просто "символ"?

Я также нашел эту ветку с многообещающим названием, но не мог понять, как это может решить мою проблему.

Answer 1

Это разновидность распространенной проблемы в системе S4, где для наследования обрабатывается вызов new с нулевыми аргументами должно работать. Это связано с тем, как реализовано наследование, когда базовый класс создается, а затем заполняется значениями из производного класса. Для создания экземпляра базового класса необходимо создать его без каких-либо аргументов. То, что у вас есть проблема, иллюстрируется

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

и решение состоит в том, чтобы предоставить аргумент по умолчанию в вашем методе инициализации

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

или иным образом организовать (например, путем тестирования missing(char) в теле initialize) для вызова конструктора без аргументов.

Вероятно, лучшая практика программирования будет диктовать, что метод инициализации занимает ... аргумент и имеет callSuper() в его теле, так что производные классы могут использовать преимущества базового класса (например, назначение поля). Чтобы избежать проблем с непреднамеренным сопоставлением безымянных аргументов, я думаю, что подпись должна в конечном итоге построиться вокруг шаблона, который выглядит как

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

Эта схема опирается на подходящее определение "пустой" nameClass, Следующее, вероятно, имеет слишком много мнений и смены перспективы, чтобы быть сразу полезным, но... Это заманчиво думать о nameClass как "строка" во фрейме данных, но лучше (потому что R лучше всего работает с векторами) думать об этом как об описании столбцов. Имея это в виду разумное представление "пустого" nameClass, где first а также last поля имеют длину 0. Тогда

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

с тестовыми примерами, такими как

> 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', ... 

Производный класс может быть определен как

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

с тестовыми примерами, такими как

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

Answer 2

Кажется, это потому, что у вас нет конструктора по умолчанию для вашего "nameClass":

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

Если вы измените свой nameClass следующим образом:

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

Затем:

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

и ваш personClass теперь функционален (хотя метод initialize довольно странный):

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"