Как написать методы принуждения - PullRequest
Новая
       18

Как написать методы принуждения

0 голосов
/ 01 декабря 2011

У меня есть несколько пользовательских эталонных классов, и я хотел бы написать методы принуждения для некоторых из них. Было бы хорошо, если бы вызов функции выглядел так: 

objectCoerce(src=obj, to="list", ...)

, где ... - важная часть, так как иногда я хочу передать дополнительные вещи для определенных принуждений (см. do.deep = TRUE/FALSE ниже.

Однако, чтобы сделать это, мне нужно реализовать своего рода «преобразователь», который принимает аргумент to, пытается создать пустой объект класса, указанного в to, а затем вызывает «обычный» метод отправки? Или есть лучший способ?

Ниже вы найдете мое текущее решение. Это работает, но я "теряю" опцию принудительного обращения к классу character", так как этот класс используется для обработки вещей в обычном диспетчере, а to = "character приведет к бесконечной рекурсии. Плюс, это много накладных расходов.

РЕДАКТИРОВАТЬ 2011-12-02

Конечно, setAs будет первым адресом для проверки. Но функция, указанная в arg def в setAs, может принимать только один аргумент, и часто это слишком жестко для меня. Например, я не вижу, как можно включить переключатель do.deep = TRUE/FALSE при использовании setAs.

Класс Defs 

setRefClass(Class="MyVirtual")

setRefClass(
    Class="A",
    contains="MyVirtual",
    fields=list(
        x="character"
    )
)

setRefClass(
    Class="B",
    contains="MyVirtual",
    fields=list(
        x.a="A",
        x.b="numeric",
        x.c="data.frame"
    )
)

setGeneric(
    name="objectCoerce",
    signature=c("src", "to"),
    def=function(src, to, ...){
        standardGeneric("objectCoerce")       
    }
)

Общий метод 

setGeneric(
    name="objectCoerce",
    signature=c("src", "to"),
    def=function(src, to, ...){
        standardGeneric("objectCoerce")       
    }
)

промежуточный трансформатор 

setMethod(
    f="objectCoerce",
    signature=signature(src="ANY", to="character"),
    definition=function(src, to, do.deep=FALSE, ...){        

    # Transform 'to' to a dummy object of class 'to'
    to.0 <- to
    # For standard R classes
    try.res <- try(eval(substitute(
        to <- CLASS(), 
        list(CLASS=as.name(to.0))
    )), silent=TRUE)
    # For S4 classes
    if(inherits(try.res, "try-error")){
        try.res <- try(eval(substitute(
            to <- new(CLASS), 
            list(CLASS=to.0)
        )), silent=TRUE)
        # For my classes. In order to get an 'hollow' object, some of them 
        # need to be instantiated by 'do.hollow=TRUE'
        if(inherits(try.res, "try-error")){
            try.res <- try(eval(substitute(
                to <- new(CLASS, do.hollow=TRUE), 
                list(CLASS=to.0)
            )), silent=TRUE)
            if(inherits(try.res, "try-error")){
                stop(try.res)
            }
        }
    }
    # Pass transformed 'to' along so the standard method 
    # dispatcher can kick in.
    out <- objectCoerce(src=src, to=to, do.deep=do.deep, ...)
    return(out)
    }
)

Метод принуждения «MyVirtual» к «списку» 

setMethod(
    f="objectCoerce",
    signature=signature(src="MyVirtual", to="list"),
    definition=function(src, to, do.deep=FALSE, ...){        

    fields <- names(getRefClass(class(src))$fields())
    out <- lapply(fields, function(x.field){
        src$field(x.field)        
    })
    names(out) <- fields

    if(do.deep){
        out <- lapply(out, function(x){
            out <- x
            if(inherits(x, "MyVirtual")){
                out <- objectCoerce(src=x, to=to, do.deep=do.deep, .ARGS=.ARGS)
            }     
            return(out)
        })
    }

    return(out)

    }
)

Тестовый прогон 

x <- new("B", x.a=new("A", x="hello world!"), x.b=1:5, 
    x.c=data.frame(a=c(TRUE, TRUE, FALSE)))

> objectCoerce(src=x, to="list")
$x.a
Reference class object of class "A"
Field "x":
[1] "hello world!"

$x.b
[1] 1 2 3 4 5

$x.c
      a
1  TRUE
2  TRUE
3 FALSE

> objectCoerce(src=x, to="list", do.deep=TRUE)
$x.a
$x.a$x
[1] "hello world!"


$x.b
[1] 1 2 3 4 5

$x.c
      a
1  TRUE
2  TRUE
3 FALSE

1 Ответ

1 голос
/ 02 декабря 2011

Может быть, использовать setAs для создания принудительного метода (хотя для написания метода лучше использовать собственный базовый класс, чем делать это для envRefClass) 

setAs("envRefClass", "list", function(from) {
    fields <- names(getRefClass(class(from))$fields())
    Map(from$field, fields)
})

, а затем 

> as(new("B"), "list")
$x.a
Reference class object of class "A"
Field "x":
character(0)

$x.b
numeric(0)

$x.c
data frame with 0 columns and 0 rows

? Глубокая версия может выглядеть как 

setAs("envRefClass", "list", function(from) {
    fields <- names(getRefClass(class(from))$fields())
    curr <- Map(from$field, fields)
    recurr <- sapply(curr, is, "envRefClass")
    curr[recurr] <- lapply(curr[recurr], as, "list")
    curr
})

У меня нет хороших идей для их объединения, кроме как создать псевдо-класс 'deep_list' и принудительный метод для этого. Я чувствую, что не понимаю ваш пост.

...