Rで無限リストを生成→S4がうまくいかずもう一歩

最近、Project Eulerみたいなのが流行っているようです。

で、これはRでもやるしかないなと思ったのでちょこちょこと解いていたんですが、何か無限リストっぽいものを作れるとうれしいような気がしたので、Rで無限リストを作る方法を探してみました。そしたらどんぴしゃなやつを発見。

データ解析言語Rによる統計的プログラミング: 第 3 回再利用可能なオブジェクト指向プログラミング

でクラスを使って最後の付近はやってあるんですが、S3のやり方で書いてあります。Tsukuba.R#2とかではS4の紹介をしたいなあと思っていたので、S4で無限リストを作るのに挑戦しようと思いました。ちゃんとしたクラスの設計とかそういうのは、http://mono.kmc.gr.jp/~oxy/w/?Streamが分かりやすかったので、これをRに移植してみました。とりあえずクラスに関するコード。lispっぽい匂いがするのは仕様です。

setClass("stream", representation(car="numeric", cdr = "function"))

setGeneric("car", function(this) standardGeneric("car"))
setMethod("car","stream",function(this){
  return(this@car)
})

setGeneric("cdr", function(this) standardGeneric("cdr"))
setMethod("cdr","stream",function(this){
  return((this@cdr)())
})

setGeneric("each", function(this,f) standardGeneric("each"))
setMethod("each","stream",function(this,f){
  (f)(car(this))
  each(cdr(this),f)
})

setGeneric("take", function(this,n) standardGeneric("take"))
setMethod("take","stream",function(this,n){
  ifelse(n==0,return(car(this)),return(take(cdr(this),n-1)))
})

setGeneric("myfilter",function(this,f){standardGeneric("myfilter")},useAsDefault=TRUE)
setMethod("myfilter","stream",function(this,f){
  ifelse((f)(car(this)),
         return(new("stream",car=car(this),cdr=function(){myfilter(cdr(this),f)})),
         return(myfilter(cdr(this),f)))
})

で、実際に使う時の関数も用意しておきます。

generate.integer <- function(n){
  new("stream",car=n,cdr=function(){generate.integer(n+1)})
}
generate.fibonacci <- function(a,b){
  new("stream",car=a,cdr=function(){generate.fibonacci(b,a+b)})
}
sieve <- function(stream){
  new("stream",car=car(stream),
      cdr=function(){sieve(myfilter(cdr(stream),function(x){x %% car(stream) != 0}))})
}

で、このまま実行すると再帰のところで怒られるので、おまじないを書いておいて*1

options(expressions=500000)

以下を実行すると、整数の無限リストが出力されます。C-cで止める。

> integer <- generate.integer(1)
> each(integer,f=print)
[1] 1
[1] 2
[1] 3
[1] 4
[1] 5
[1] 6
[1] 7

同じ感じでフィボナッチ数の無限リストもできたりします。

> fibonacci <- generate.fibonacci(0,1)
> each(fibonacci,f=print)
[1] 0
[1] 1
[1] 1
[1] 2
[1] 3
[1] 5
[1] 8
[1] 13
[1] 21
[1] 34
[1] 55
[1] 89

taka関数を使うと、指定した添字のフィボナッチ数を取り出せます。

> take(fibonacci,10)
[1] 55
take(fibonacci,1:10)
[1] 1
> mapply(function(x){take(fibonacci,x)},1:10)
 [1]  1  1  2  3  5  8 13 21 34 55

素数に関する無限リストも同様にできて、

> each(sieve(generate.integer(2)),f=print)
[1] 2
[1] 3
[1] 5
[1] 7
[1] 11
[1] 13
[1] 17
[1] 19
[1] 23
[1] 29
[1] 31
[1] 37
[1] 41
> take(sieve(generate.integer(2)),10)
[1] 31

無限リストに関してはここまで。これについてはうまくできました。

S4関係で解決できなかったこと

でも、上のコードで一箇所うまく自分のやりたかったことができていません。それはfilter関数のところなんですが、自分のコードは

setGeneric("myfilter",function(this,f){standardGeneric("myfilter")},useAsDefault=TRUE)
setMethod("myfilter","stream",function(this,f){
  ifelse((f)(car(this)),
         return(new("stream",car=car(this),cdr=function(){myfilter(cdr(this),f)})),
         return(myfilter(cdr(this),f)))
})

という感じで「myfilter」関数とかいう名前になっています。これをfilter関数としてやってみると、こんなエラーが

> setGeneric("filter",function(this,f){standardGeneric("filter")},useAsDefault=TRUE)
 以下にエラー makeGeneric(name, fdef, fdeflt, group = group, valueClass = valueClass,  : 
   "filter" (this, f) に対する総称的関数の形式的引数は、既定 (x, filter, method, sides, circular, init) として使われる非総称的なそれの引数と異なります

たぶん理由はfilter関数がすでにあるからかな*2。時系列に関する関数。すでにgeneritcなものがあるんだから、やらなくていいよっていうことなのかなー?

> filter
function (x, filter, method = c("convolution", "recursive"), 
    sides = 2, circular = FALSE, init = NULL) 
{
    method <- match.arg(method)
中略
    else "ts"
    y
}
<environment: namespace:stats>

じゃあ、とりあえずstreamクラスに関するgenericな関数として定義すればいいかなと思ってやると、エラーが。。。

> setMethod("filter","stream",function(this,f){
+   ifelse((f)(car(this)),
+          return(new("stream",car=car(this),cdr=function(){filter(cdr(this),f)})),
+          return(filter(cdr(this),f)))
+ })
 新しいジェネリック関数 "filter" を ".GlobalEnv" 中に生成します 
 以下にエラー conformMethod(signature, mnames, fnames, f, fdef) : 
  In method for function "filter":  メソッド定義中で使われなかった形式的引数はシグナチャ (x = "stream") 中にあってはいけません