カスタムメイドの参照クラスがたくさんあり、それらの強制メソッドを書きたいと思っています。関数呼び出しが次のようになるといいでしょう。
objectCoerce(src=obj, to="list", ...)
...特定の強制のために追加のものを渡したい場合があるため、重要な部分はどこですか（以下を参照） do.deep = TRUE/FALSE。
ただし、それを行うには、to引数を取り、指定されたクラスの空のオブジェクトをインスタンス化してからto「通常の」メソッドディスパッチを呼び出す「トランスフォーマー」のようなものを実装する必要がありますか? それとももっと良い方法がありますか？
以下に、私の現在の解決策を示します。character"それは機能しますが、このクラスは通常のディスパッチャーへの処理に使用されto = "character、無限再帰が発生するため、クラスに強制するオプションを「失っています」 。さらに、それは多くのオーバーヘッドです。
編集 2011-12-02
もちろんsetAs、チェックする最初のアドレスになります。しかし、arg defin で指定された関数setAsは 1 つの引数しかとることができません。do.deep = TRUE/FALSEたとえば、を使用するときにスイッチを含める方法がわかりませんsetAs。
クラス定義
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」から「list」への強制メソッド
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