MonadFixの理解のために(1)---fixを考える3

しつこく再帰処理とfixに粘着します．果たして，mfixにたどり着くのか（苦笑）．

repmin（A recursive do for Haskell, by Levent Erk\"ok, John Launchbury, Haskell Workshop 2002, pages: 29-37. Pittsburgh, Pennsylvaniaより）

次のお題は「repmin」です．repminとは，（二分）木のリーフの値を，すべてのリーフの値の最小値(min)に置き換える（replace）問題のことです．木を

data Tree a = L a | N (Tree a) (Tree a) deriving Show

と定義すると，Lがリーフの構成子，Nがノードの構成子となり，木は，例えば

(N (L 2) (N (L 5) (N (N (L 10) (L 9) ) (L 3) ))

というように表現されます．この木のリーフの値で最小なのは「2」なので，この木から

(N (L 2) (N (L 2) (N (N (L 2) (L 2) ) (L 2) ))

を作るということになります．もちろん，すべてのリーフを辿って最小値を計算してから，もう一度置き換えていくという2パスならほとんど自明です．

-- data Tree a = L a | N (Tree a) (Tree a) deriving Show

getvals :: Tree a -> [a]
getvals (L a) = [a]
getvals (N l r) = (getvals l)++(getvals r)

rep :: Tree a -> Tree a
rep (L a) m   = L m
rep (N l r) m = N (rep l m) (rep r m)

repmin' :: (Ord a)=>Tree a -> Tree a
repmin' t = rep t (minimum $ getvals t)

これを1パスで処理するというわけです．見事で綺麗な解答があります．

-- data Tree a = L a | N (Tree a) (Tree a) deriving Show
copy :: Tree Int -> Int -> (Tree Int, Int)
copy (L a)   m = (L m, a)
copy (N l r) m = let (l', ml) = copy l m
                     (r', mr) = copy r m
                 in (N l' r', ml `min` mr)

repmin :: Tree Int -> Tree Int
repmin t = let (t', m) = copy t m in t'

これまた騙されたようなコードですが，遅延評価できっちり動きます．

repminに木tを与えると，リーフに関しては，その値aを「外」にだし，mを中にいれます．しかし，mは必要ないので評価されません．二つのリーフからなるノードにおいては，各リーフに関してその値がそれぞれ「外」にでており，中にはmが入り込んでます（が，もちろんmは評価されません）．そして，外に出された値が比較され，小さい方が採用されて新しいノードが出来上がります．

これを再帰的に繰り返すことで「中身が全部mの木」と「中身だった値の最小値」のタプルが出来上がります．これを(t',m)とおくので，ここで始めてmが「中身だった値の最小値」として確定して，結果，「中身が全部mの木」t'も「中身が全部「最小値」」の木となり，このt'を返せば計算完了です．

まず秀逸なのはcopyです．copy単体だと

*Main> copy (N (L 2) (N (L 5) (N (N (L 10) (N (L 1) (L 4)) ) (L 3) ))) 100
(N (L 100) (N (L 100) (N (N (L 100) (N (L 100) (L 100))) (L 100))),1)

となります．最小値が外にでてきて，与えた引数が中に入り込みます．100は100である必要は全くありません．ですので，任意の値mを「とりあえず」与えておいて（遅延評価だからそのまま放置されます），そのmを「外にでてきた最小値」にしてしまうという細工がrepminの中のletです．こうして，期待した動作が実現できるという段取りです．

さて，関数repminは二重に再帰になってます．repminそのものが再帰，さらに使われているcopyも再帰です．あえて，fixを使ってみます．

fix f = let x =f x in x

g:: (Tree Int -> Int -> (Tree Int, Int))-> (Tree Int -> Int -> (Tree Int, Int))
g cp = \ t m  -> case t of
                  (L a)   -> (L m, a)
                  (N l r) -> let (l',ml) = cp l m
                                 (r',mr) = cp r m
                             in (N l' r', ml `min` mr)

copy:: Tree Int -> Int -> (Tree Int, Int)
copy = fix g

repmin :: Tree Int -> Tree Int
repmin t = (fst.(copy t)) (fix $ (snd.(copy t)) )

。。。copyはともかく，repmin本体はやっぱり難読です．letの偉さが分かります．タプル（alistという方がいいかな）の片方だけが再帰というか不動点なので，そこだけ分離してfixにいれたのですが，分かりにくいです．copyの方は今までの例と同じです．遅延パターンの必要はないことと型に注意です．