MonadFixの理解のために(2)---リストモナドでmfix考える3

前回リストモナドでlistfixという関数をでっちあげてそれが期待した動作をすることを主張しました.実際コードを走らせて見れば動きます.今回はまずは,その動きを追いかけてみます.

pairwise swapでリストモナドのmfixを追いかける

面倒なので,listfixなんていわないで,もうmfixにします.本来はControl.Monad.Fixモジュールで定義されているMonadFixクラスのクラスメソッドですが,参照のために

data Tree = L Int | N Tree Tree deriving Show

fix::(a->a)->a
fix f = let x = f x in x

mfix::(a->[a])->[a]
mfix f = case fix(f.head) of
            []   -> []
            x:_ -> x:mfix (tail.f)

replace::Int->Tree->[(Tree,Int)]
replace x (L y) = [(L x,y)]
replace x (N l r) = [(N l' r, y) | (l',y) <- replace x l ]
                    ++ 
                    [(N l r', y) | (r',y) <- replace x r ]

pairSwaps:: Tree -> [Tree]
pairSwaps e = (mfix  f)  >>= \(e'',n) -> return e''
              where f  ~(e'', n) = do (e', m) <- replace n e 
                                      (e'',n) <- replace m e' 
                                      return (e'',n)

と必要なものは一緒にしておきます.そして

pairSwaps (N (L 1) (L 2))
{-- 結果は
[N (L 1) (L 2), N (L 2) (L 1),
 N (L 2) (L 1), N (L 1) (L 2)]
--}

の動きを追いかけてみることにします(これ以上複雑になると本質ではないところで煩雑になりそうです).

mfix f = case fix(f.head) of
            []   -> []
            x:_ -> x:mfix (tail.f)

f  ~(e'', n) = do (e', m) <- replace n e 
                  (e'',n) <- replace m e' 
                  return (e'',n)

なので,ひとまずは(f.head)[(e'',n),...]を考えます.

(f.head) ~[(e'',n),...]
== f ~(e'',n)
== (e', m) <- replace n  (N (L 1) (L 2))
   (e'',n) <- replace m e' 
   return (e'',n)
== [(N (L n) (L 2), 1), (N (L 1) (L n), 2)] 
   >>= \(e',m) -> replace m e' >>= return
== [(N (L 1) (L 2), n), (N (L n) (L 1), 2),
    (N (L 2) (L n), 1), (N (L 1) (L 2), n) ]

これのfixなので,

[(e'',n),...]
= [(N (L 1) (L 2), n), (N (L n) (L 1), 2),
   (N (L 2) (L n), 1), (N (L 1) (L 2), n) ]

となって,mfixのcaseの中の下のほうがつかわれて

(N (L 1) (L 2), n):mfix (tail.f)

が現れます.次は同様にtail.fを考えますが,fix(tail.f.head)は全く同様な計算で

[(e'',n),...]
= [                    (N (L n) (L 1), 2),
   (N (L 2) (L n), 1), (N (L 1) (L 2), n) ]

となります.したがって,今度はn=2が得られて

(N (L 2) (L 1), 2):mfix (tail.f)

が現れます.同様に次は

[(e'',n),...]
= [                    
   (N (L 2) (L n), 1), (N (L 1) (L 2), n) ]
n=1
(N (L 2) (L 1), 1):mfix (tail.f)

次は

[(e'',n),...]
= [                    
                       (N (L 1) (L 2), n) ]
(N (L 1) (L 2), n):mfix (tail.f)

最後は

[(e'',n),...]
= [                    
                                          ]
[]

となり,最終的に

[ (N (L 1) (L 2), n), (N (L 2) (L 1), 2)
  (N (L 2) (L 1), 1), (N (L 1) (L 2), n) ]

がmfixの結果として現れます.nは評価されてないことに注意です.これをreturnに渡すのですが,その際にnを落とすので,最終的には

[ (N (L 1) (L 2)), (N (L 2) (L 1))
  (N (L 2) (L 1)), (N (L 1) (L 2)) ]

が得られて所望の結果となります.めでたしめでたし.