データ再帰という考えと双方向リスト

今日はちょっとコードの効率化の話をいったんお休みして、別の話を書きたいと思います。

以前に書いたControl.Arrow.loopでも実はさりげなく出ていたのですが、Haskellではletとwhere節の部分でちょっと変わったことができます。

Control.Arrow.loopの定義を見てみます：

instance ArrowLoop (->) where
　　loop f b = c where (c,d) = f (b,d)

ちょっと不思議な関数定義なわけなんですが、特に変わっている部分があります。…それは変数dの宣言部分です。

　(c,d) = f (b,d)

loopの説明によると、これの影響で変数dは再帰の全ての段にわたって同じインスタンスが参照されているということらしいです。つまり、whereとletでは定義内での変数の再帰的参照が許されているようです。
おかげで、こんなこともできます。

　a = b
　b = a

まぁ、もちろんどこかでa, bそれぞれに値を与えてやる必要があるわけですが…

ここでちょっと双方向リストについて考えてみたいと思います。リストの各要素が自分の前と後の要素へのポインタを保持しているわけです。型自身の定義としては：

　data DList a = Empty | MkDList a (DList a) (DList a)

見たいなものが妥当なところでしょう…からのリストはEmpty、要素が一つしかないリストは：

　one a = MkDList a Empty Empty

とやればいい。では、要素2つのリストはどうやったらいいでしょう？

　two a1 a2 = MkDList a1 Empty ????

うーん、どうやったら2つのDList型のインスタンスを作ってお互いを参照できるでしょう？ここで、先ほどのwhere節の再帰的参照が生きてきます。

　two a1 a2 = l1
　　where
　　　l1 = MkDList a1 Empty l2
　　　l2 = MkDList a2 l1 Empty

とやればいいわけです…なんだか面白くなってきました…ちなみにこの参照パターンはデータ再帰(data recursion)と呼ばれているようです…僕には直感的に理解できる名前ではなかったですが…

それじゃあ、任意の長さのDListを作る関数:

　dlist :: [a] -> DList a

はどうやったらかけるでしょう？最初に思いついたのはApplicativeを使ったバージョンです：

import Control.Applicative
dlist :: [a] -> DList a
dlist as = dl
　where
　　dls@(dl:dlss) = getZipList $ 
　　　( (ZipList.(map MkDList) ) as) <*> prvs <*> nxts
　　prvs = ZipList $ Empty : dls
　　nxts = ZipList $ dlss ++ [Empty]

これはコンパイルは通るのですが、いざ実行させてみるとメモリーが足りなくなって中断してしまいます…なぜかは良くわかりませんが、おそらくprvsかnxtsの定義か参照に問題があるのでしょう…きれいにかけたと思ったのですが、動かないんじゃぁしょうがありません…

これがダメならと思って思いついたのが、オーソドックスに再帰を使う考えです：

dlist as = _dlist as Empty

_dlist :: [a] -> DList a -> DList a
_dlist [ ] _ = Empty
_dlist (a:as) prv = this
　where
　　this = MkDList a prv nxt
　　nxt = dlist as this

これはうまく動いてくれます。DListをもらってそれをトラバースする関数も書いて見ました：

next :: DList a -> DList a
next Empty = Empty
next (MkDList _ _ n) = n

prev :: DList a -> DList a
prev Empty = Empty
prev (MkDList _ p _) = p

この辺はごくシンプルですね…次にDList版のtakeを書いてみました。双方向なのでtakeNxtとtakePrv
です…

takeNxt :: DList a -> Int -> ([a], DList a)
takeNxt Empty _ = ([ ], Empty)
takeNxt _ 0 = ([ ], Empty)
takeNxt lst@(MkDList a _ nxt) 1 = ([a], lst)
takeNxt lst@(MkDList a _ nxt) i = (a:as, nxt')
　where
　　(as, nxt') = takeNxt nxt (i - 1)

takePrv :: DList a -> Int -> ([a], DList a)
takePrv Empty _ = ([ ], Empty)
takePrv _ 0 = ([ ], Empty)
takePrv lst@(MkDList a prv _) 1 = ([a], lst)
takePrv lst@(MkDList a prv _) i = (a:as, prv')
　where
　　(as, prv') = takePrv prv (i - 1)

ちょっとややこしいですね…これを使えば、

print $ takeNxt 5 $ dlist [1..9]
==> [1, 2, 3, 4, 5]

print $ takePrv 3 $ next $ next $ next $ next $ dlist [1..9]
==> [5, 4, 3]

なんてことになります…ふむふむ。

それじゃぁ、DListでループしているものはどうやったら作れるでしょう？先頭のprevは最後尾、最後尾のnextが先頭になるようにしなくてはいけません…DListのトリッキーなところは、Immutableなので、インスタンスの生成時にリンクを全て設定してやらなくてはいけないことです。

ということは、先頭要素を作るときには最後尾の要素を参照する変数がなくてはいけないことになります…むむむ。と、ここで、最初に出てきたControl.Arrow.loopがどうやら使えそうなことに気づきます…やってみようということで書いてみたのがこれ：

import Control.Arrow

dlistLoop :: [a] -> DList a
dlistLoop as = (loop _dListLoop) (as, Empty, Empty)

_dListLoop (([ ], hd, prv), m) = (hd, prv)

_dListLoop ((a:as, Empty, Empty), m) = (this, m')
　where
　　this = MkDList a m' nxt
　　(nxt, m') = _dListLoop ((as, this, this), m)

_dListLoop ((a:as, hd, prv), m) = (this, m')
　where
　　this = MkDList a prv nxt
　　(nxt, m') = _dListLoop ((as, hd, this), m)

ちょっと解説すると、_dListLoopの入力パラメタhdは最後尾に先頭要素の参照を渡すためのもの、prvは直前の要素を渡すためのものになっています…

実際に使ってみます…

main = do
　print first5
　print prev3
　print next5
　　where
　　　lst = dlistLoop [1..9]
　　　(first5, l5) = takeNxt lst 10 
　　　(prev3, p3) = takePrv l5 3
　　　(next5, n5) = takeNxt p3 5

==>
[1,2,3,4,5,6,7,8,9,1]
[1,9,8]
[8,9,1,2,3]

ということで、1から9までの要素を含む、ループしたリンクリストですから、先頭から要素を10個とると、
[1,2,3,4,5,6,7,8,9,1]となりますし、1のところから後ろ向きに要素を3個とると[1, 9, 8]となりますね…
どうやらちゃんと動いているようです…

C/C++ではリンクリストは双方向でも片方向でも、ループしていてもしていなくても、コードはややこしいですが、ポインタのことさえわかれば書くことはできますね…でもHaskellではループした双方向リンクリストはControl.Arrow.loopのようなちょっと不思議な関数の助けがなくては作れない…まぁ、Mutableなバージョンであればそんなことはないはずですが…

そして、リストと違って、要素の変更の際のコストは常に全体のコピーになるはずです。要素一つを書き換えるためにはそのようそのために新しいDListをアロケートしなくてはいけなくて、ということはそのリストの両側の要素のポインタをアップデートしなくてはいけない…それが回りまわって、DList全体を書き換えることになります。
DListがループしていたとすると、要素を全部リストに取り込んで、データの書き換えをした後、dlistLoopで新しいDListを作り直したほうが話が早そうです…そのためにはループしたDListから全ての要素をとる関数が必要になってきますね…どうやったらかけるでしょう？

getAll lst = _getAll lst lst
_getAll Empty _ = [ ]
_getAll lst@(MkDList a _ nxt) hd
　| lst == hd = [ ]
　| otherwise = a:(_getAll nxt hd)

なんてやってみたのですが、これは無限ループに陥ってしまって終了しません。ｔraceをつけたりしてみた感じでは

　lst == hd

がdeepな比較を行っているために終了しない感じです…むむむ…どうやればよいのでしょう…

今日はこの辺で…
ではでは。