質問

私はたくさんのカスタムメイドの参照クラスを持っています、そして、それらのいくつかのために強制方法を書きたいと思っています。関数呼び出しが次のようになるといいでしょう：

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

どこ ... 特定の強制のために追加のものを渡したい場合があるため、重要な部分です（参照してください do.deep = TRUE/FALSE 下。

ただし、それを行うには、次のような「トランス」のようなものを実装する必要がありますか to 議論は、によって指定されたクラスの空のオブジェクトをインスタンス化しようとします to そして、「通常の」メソッドディスパッチを呼び出しますか？それともより良い方法はありますか？

以下に私の現在のソリューションがあります。それは機能しますが、私はクラスに強制するオプションを「失っています」 character" このクラスは、通常のディスパッチャーと to = "character 無限の再帰につながります。さらに、オーバーヘッドがたくさんあります。

編集2011-12-02

もちろん setAs チェックする最初のアドレスになります。しかし、argによって指定された関数 def の setAs 1つの議論しか取ることができず、多くの場合、それは私にはあまりにも硬すぎます。たとえば、どのように含めることができるかわかりません 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
役に立ちましたか？

解決

Setasを使用してCoerceメソッドを作成するかもしれません（ただし、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
})

Psuedoクラスの「deep_list」とコースメソッドを作成する以外に、これらを組み合わせるための良いアイデアはありません。私はあなたの投稿を理解していないように感じます。

ライセンス： CC-BY-SA と 帰属
所属していません StackOverflow
scroll top