удваивает NextMethod () в r - PullRequest
Новая
       32

удваивает NextMethod () в r

0 голосов
/ 06 февраля 2019

У меня проблемы с тем, как заставить работать следующий код.В частности, что я должен иметь вместо «???»чтобы получить результат c (4,7,1) 

letter<- function()
{
  x<- numeric(0)
  class(x)<- append(class(x), "letter")
  return(x)
}


a<- function()
{
   obj<- letter()
   class(obj)<- append(class(obj),"a")
   return(obj)
}

aa<- function()
{
   obj<- a()
   class(obj)<- append(class(obj),"aa")
   return(obj)
}

met<- function(obj, ...)
{
   UseMethod("met", obj)
}

met.letter<- function(obj, ???)
{
  NextMethod(???)
}

met.a<- function(obj, ???)
{
   x<-4
   z<-1
   NextMethod(???)
}

met.aa<- function(obj, ???)
{
  y=y+1
  return(c(x,y,z))
}

aaobj<- aa()

met(aaobj, y=6)
# to return c(4,7,1)

Я не могу понять, как передать аргументы в следующий метод, когда они создаются в текущем методе, и я не хочупередать эти аргументы при вызове метода.

1 Ответ

0 голосов
/ 07 февраля 2019

Вот OO-подобная версия вашего кода с «выводом журнала», чтобы указать, как он работает: 

# Class Hierarchy:
# AA inherits from A inherits from letter (= base class)

# Constructors ---------------------------------------------
letter <- function()
{
  x <- numeric(0)  # this shall be an class attribute
  class(x) <- append("letter", class(x))
  return(x)
}

a <- function()   # class "a" inherits from class "letter"
{
  obj <- letter()
  class(obj) <- append("a", class(obj))  # attach the specialized class first!
  return(obj)
}


aa <- function()    # class "aa" inherits from class "a"
{
  obj <- a()
  class(obj) <- append("aa", class(obj))
  return(obj)
}

# Class methods -------------------------------------------

# This is a function in the base class "letter" that is inherited in the sub classes
# so that every sub class can provide its own implementation (polymorphism).
# To register such a generic function (= function call dispatching to class-specific functions/methods)
# "UseMethod" is called
met <- function(obj, x)  # met = method?!
{
  UseMethod("met", obj)    # "dispatch": Call the first existing function of pattern "met.<class>"
  # Code after this line will never be executed due to calling "UseMethod"
  print("met")
}

met.aa <- function(obj, x)
{
  print("met.aa - starting")
  x = x + 1
  NextMethod("met", obj)  # as last code in the function: Returns the return value of this function!
  # Do not add code after "NextMethod" or you will get the output of this code as return value
  # instead of the return value of NextMethod!
  # print("met.aa - leaving")
}

met.a <- function(obj, x)
{
  print("met.a - starting")
  x <- c(4, x, 1)
  res <- NextMethod("met", obj) # , c(4, x, 1))
  print("met.a - leaving")  #
  return(res)
}

met.letter<- function(obj, x)   # x may be a vector!
{
  print("met.letter starting")
  # "append" looses the attributes (class!) so we reassign it
  # a() should better return a list with one vector element as "class attribute"
  # so that the attributes keep untouched if changing the "class attribute"
  old.classes <- class(obj)
  obj <- append(obj, x)
  class(obj) <- old.classes
  # no NextMethod() call - it is the base class (= root!)
  return(obj)
}

met.default <- function(obj, x) {
  warning("met.default: not implemented")
}

aaobj <- aa()
aaobj
# numeric(0)
# attr(,"class")
# [1] "aa"      "a"       "letter"  "numeric"

aaobj <- met(aaobj, 6)
aaobj
# [1] 4 7 1

Примечание. Имя вашего класса следует указывать в начале (а не в конце)атрибут класса, чтобы при вызове универсального метода сначала был найден и вызван наиболее специализированный метод класса.

Подробнее см. http://www.stackoverflow.com/q/45175988

...