余再帰あれこれ

corecursion.hs

{--- 余再帰とその利用例 ---}

{- 末尾再帰と再帰と余再帰
 -
 - 参考: http://d.hatena.ne.jp/kazu-yamamoto/20091122/1258899591
 -
 -  末尾再帰 : 引数に結果を蓄積し、自身へgotoして処理の流れが戻ってこないようにする。正格なデータを処理する時に用いるとスタックやヒープの節約になる。
 -      foldl f a []     = a
 -      foldl f a (x:xs) = foldl f (f a x) xs
 -
 -  再帰 : 何でもいいから関数内で自分を呼び出してれば再帰。スタックもヒープも消費する。
 -      quicksort []     = []
 -      quicksort (x:xs) = quicksort [ l | l <- xs, l <= x ] ++ [x] ++ quicksort [ r | r <- xs, x < r ]
 -
 -  余再帰 : データ構築の流れに沿って再帰。再帰する際に引数に取っている遅延データのうち、後ろの残りのみを取る。
 -           最後のデータまで処理しきらなくても最初の方のデータを参照可能。遅延構築可能なデータの構築に用いるとスタックやヒープの節約になる。
 -      foldr f a []     = a
 -      foldr f a (x:xs) = x `f` foldr f a xs
 -}


{--- 余再帰の例 ---}
-- 例1, 深さ優先探索(depth first search)
dfs :: Tree a -> [a]
dfs t = go t []
    where
    go Leaf xs         = xs
    go (Node l x r) xs = x : go l (go r xs)


{--- 余再帰と遅延評価の合わせ技 ---}

-- 遅延構築可能なデータ型を用いることで、自分が今構築しているデータを、自分の再帰時の引数に取って読み込んでいく事が出来る。
-- これは余再帰の時に可能になる。ウロボロスみたいな構造。

-- 例1, [n..]の再実装。succしてるだけとも言う。
nn :: Integer -> [Integer]
nn s = s : nn' (nn s)
    where nn' (n:ns) = n + 1 : nn' ns

-- 例2, フィボナッチ数列。スタートとパターンマッチが複雑化しただけで例1と大差ない。
fib :: [Integer]
fib = 1 : 1 : fib' fib
    where fib' (a:xs@(b:_)) = a + b : fib' xs


{- Breadth Fiest Search 幅優先探索を余再帰で書く。
 -
 - 参考: http://d.hatena.ne.jp/kazu-yamamoto/20121107/1352259739
 -
 - 幅優先探索を余再帰でどのように書くか？
 -  幅優先探索は元々キューにデータを置いてそれを頭から順に処理していく構造をしているので余再帰で書ける。
 -  そこで遅延評価の得意技である「ブツは既に出来ていると見なす」を利用し、以下の手順で記述する。
 -      1, 根の子を根とする部分木を順番に並べていく関数(walk)を用意。
 -      2, 各ノードを根とした部分木が幅優先探索での走査順に並んだ関数(queue)を用意。walkを呼び出す。
 -      3, queueの中身を適当に綺麗にする。
 -      4, おわり
 -}

data Tree a = Leaf
            | Node (Tree a) a (Tree a)
            deriving Show

bfs :: Tree a -> [a]
bfs t = cleanup queue
    where
    queue = t : walk 1 queue -- walkは第二引数の根は並べないため、自分で先頭に置く必要がある。
    cleanup = map extract . filter isNode

-- 0で終了になるのは、Leafの数はNodeの数よりも常に1つ多いため。従ってwalkを呼び出す時は1を与える事によって、全てのLeafを踏んだ時に0になる。
walk :: Int -> [Tree a] -> [Tree a]
walk 0 _                = []
walk n (Leaf : q)       = walk (n-1) q -- Leafを踏んだら黙って-1して後続の子を踏みに行く。
walk n (Node l _ r : q) = l : r : walk (n+1) q -- Nodeを踏んだら子を並べる。qはここで並べた子を末尾に含むリスト。walkのメイン作業。
walk _ _                = error "walk"

extract :: Tree a -> a
extract (Node _ a _) = a
extract _            = error "extract"

isNode :: Tree a -> Bool
isNode (Node _ _ _) = True
isNode _            = False

testData :: Tree Int
testData = (Node (Node (Node Leaf 3 Leaf) 2 (Node Leaf 4 Leaf)) 1 (Node (Node Leaf 6 Leaf) 5 (Node Leaf 7 Leaf)))