Arrowの話をしよう　(2)不動点と再帰

学習/備忘 Haskell/Category theory

   今回圏論の話は出ません。

   関数型言語勉強の中に、不動点コンビネータは避けては通れない道ですね。不動点とかなんとなく難しい印象がありますが、意外に簡単です。以下は定義(Wikipediaから)：

関数　f　の不動点とは、関数　f(x) = x　を満たすような　x　のことという。
不動点コンビネータ　fix　とは、下記のように関数　f　の不動点を返すような高階関数　fix　のこと。

fix(f) = f(fix(f))

   不動点は中学の連立方程式の知識さえあれば誰でも計算できるんだろう：

f(x) = x
f(x) = 42 => x = 42

f(x) = x
f(x) = x^2 => x^2 - x = 0 => x(x - 1) = 0 => x = 0 or x = 1

   そして不動点コンビネータはこの不動点を計算してくれる関数のこと。全然難しくないでしょう？
   Haskellでは遅延評価のおかげで不動点コンビネータの定義式通りに書けます：

fix f = f (fix f)

   遅延評価のない厳格言語だったらこの関数を実行すると括弧中の式をまず評価され、無限展開になってしまう。遅延評価凄いですね〜
   そして予想通り、　fix f　 は　f　 の不動点を返してくれます：

fix (\x -> 5)                            -- = 5
fix (\x -> 3.142*2)                      -- = 6.284
abs' (-1) where abs' = fix (\x -> abs)   -- = 1

   では、

fix (\x -> x*x)

   は何を返してくれるかな〜？ 勿論　(0, 1)　や　[0, 1]　などではありません（本当にそうだったらそれはそれで凄いですけど）。先の例で、　f　はパラメータと関係ない固定値を返す定数関数だから、　f (fix f)　の　(...)　部分を展開しなくても済みましたが（それも遅延評価のお陰）、今の例では　f (...)　だけ見ると、なにを返すのが分からないから、仕方なく　(...)　の部分も展開するしかない。しかし　(...)　は(fix f = f (fix f))であることがわかったと、今度は更に中の括弧を展開しなければならない、ということで、無限ループになってしまう。じゃ意味ないじゃない？いいえ、実はこの中にある可能性を秘めっています――もし　f　は更に関数を返し、この関数が　f　のパラメータを含めた場合はどうなるかな？

fix (\x ->\n -> x + n ) -- 関数　\n -> x + n　を返す。

   こうすると、　x　は　f　から独立してしまい、言い換えば　x　の意味を関数定義する時点で解釈しなければならなくなってしまう。この場合だと、コンパイラが取れるのは　x　を関数として解釈するか素直に展開してループを気付くかの二択、まぁどっちでもエラーになるんでしょう。さて、この　x　は何かを忘れた人のために、　x　は　fix f　です。つまり上記の例に返してくれた関数は：

\n -> x + n 
= \n -> fix f + n 
= \n -> fix (\x ->\n -> x + n ) + n 
= \n -> (\n' -> x + n') + n

   同じ構造をまた現れました。気付いたと思いますが、そう、この特性を利用して、無名関数の再帰を実現できます。

-- 階乗の例
fix (\f -> \n -> if n > 1 then n * f (n-1) else 1)

-- 展開すると
\n -> if n > 1 
      then n * ((\n' -> if n' > 1 then n' * f (n'-1) else 1) (n-1))
      else 1

   面白いでしょう？ちなみに遅延評価のない厳格言語で不動点コンビネータの定義は、さきお話したテクニックで：

def fix( f ):
    return lambda x: f((fix(f)))(x)

   のようにクロージャを返すのが一般的です。余談ですが、不動点コンビネータといえばかの有名な「Yコンビネータ」がありますが、あれは実用的なものではありません。不動点コンビネータ　fix　の定義の中に、自分名前を使って再帰してますが、Yコンビネータは名前再帰使わずに不動点コンビネータを実装したとのことです。
   さて、ここから本題に入りましょう、つまり、Arrowの再帰です。すべてのArrowが再帰できるわけでありません。再帰できるのはArrowLoopクラスのインスタンスを定義したArrowだけです。

class Arrow a => ArrowLoop a where
  loop :: a (b, d) (c, d) -> a b c

   またタプルか…しょうがない、そのうち慣れると信じましょう〜さて、幸い一番簡単なArrow(->)はArrowLoopのインスタンスなので、定義を見てみよう：

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

   また珍妙なやつが出てきやがって…そもそも　let　文中の　d　はなんだ？入力のどこにもねぇぞ…
   実はHaskellの　let　文中に、バインド先の変数は後方へ循環参照することができます。先紹介した関数　fix　、Data.Functionはこう定義した：

fix f = let x = f x in x

   これ展開すると私たち定義の　fix　と同じになります：

fix f = f (f (f ...)

   つまり：

let x = f x in x = fix f
                 = fix (\x -> f x)
                 = let y = fix (\x -> f x) in y

   のように循環参照を剥げます。では、loop　も同じやり方でやって見ましょう：

loop f = let ~(c, d) = f (b, d) in c
       = let (c, _) = fix (\ ~(_, d) -> f (b, d)) in c
       = fst $ fix (\ ~x -> f (b, snd x))
       = fst $ f (b, snd (fix (\ ~x -> f (b, snd x)))
       = fst $ f (b, snd $ f (b, snd ...) )

   なるほど、loop　が　f　の出力タプルの二番目要素を入力タプルの二番目に繋げってるということですね。イメージとしては下図のように：

   つまり、入力と出力の二番目要素は　loop　内部再帰の橋渡しをしっており、ループの停止条件は出力の二番目要素に入力の二番目要素を含まれない時になります。以下は階乗の例のArrow版：

loop (\(n, f) -> (f n, \n -> if n > 1 then n * f (n-1) else 1))

   最初の例と比べるとちょっと面白い事が見えてます。最初の例(fix版)に再帰ごとに変わるのが　n　に対して、Arrow版では変わるのが　f　です。
   さて、このまま生　loop　を使ってもいいが、もっと一般的な使い方があります。再帰　let　と　fix、mdo/do rec　と　mfix　の関係のように、loop　を書く為の構文も存在しています。階乗の例はこうにも書けます：

proc n -> do rec v <- returnA -< f n
                 f <- returnA -< (\n -> if n > 1 then n * f (n-1) else 1)
             returnA -< v

   この記法で書くとfが内部変数ってことをすぐわかり、主観的ですが慣れると結構書きやすいと思います。因みに　rec　ブロック展開するとこんな感じです：

proc n -> do v <- loop (\(n, f) -> (f n, \n -> if n > 1 then n * f (n-1) else 1)) -< n
             returnA -< v

   この簡単な例だと別にどっちでもいいが、loop　の内部少しでも複雑すると眼に見える差が出て来ます。次の例はRoss Patersonの論文『A New Notation for Arrows』中のsynchronous circuits:
   次のリセットつきカウンターの実装について考えてみよう：

   Arrowでの実装は非常にストレートで：

class ArrowLoop a => ArrowCircuit a where
  delay :: b -> a b b
  
counter :: ArrowCircuit a => a Bool Int
counter = proc reset -> do
            rec output <- returnA -< if reset then 0 else next
                next <- delay 0 -< output + 1
            returnA -< output

   まず　delay　をメンバー関数としてArrowCircuitクラスを定義し、あとは回路図のまんまです。
   ここもし　rec　ブロックを使わずに生　loop　を使うとこうなります：
   中間変数が増えるほど面倒さも増えるのがわかります。

counter = proc reset -> do 
            output <- loop (proc (reset, (next, output)) -> do
                                                     output <- returnA -< if reset then 0 else next
                                                     next <- delay 0 -< output + 1
                                                     returnA -< (output, (next, output)) ) -< reset
            returnA -< output

   ついでにcounter example完全なコードもここに貼ります：

{-# LANGUAGE Arrows #-}

module Main where

import Prelude
import Control.Arrow
import qualified Control.Category as Cat

class ArrowLoop a => ArrowCircuit a where
  delay :: b -> a b b

counter = proc reset -> do
            rec output <- returnA -< if reset then 0 else next
                next <- delay 0 -< output + 1
            returnA -< output

type Seq a = [a]

newtype SeqMap b c = SM { runSM :: Seq b -> Seq c }

instance Cat.Category SeqMap where
  id = Cat.id
  SM g . SM f = SM ((Cat..) g f)

mapSeq = map
zipSeq (a, b) = zip a b
unzipSeq = unzip

instance Arrow SeqMap where
  arr f = SM (mapSeq f)
  first (SM f) = SM ( zipSeq . first f . unzipSeq  )

instance ArrowLoop SeqMap where
  loop (SM f) = SM (\as -> 
            let (bs, cs) = unzipSeq . f . zipSeq $ (as, (stream cs)) in bs)
    where stream ~(x:xs) = x:stream xs
-- this example code in the thesis will cause infinite loop
-- loop (SM f) = SM (loop (unzipSeq . f . zipSeq))

instance ArrowCircuit SeqMap where
  delay x = SM ((:) x)

main = print $ runSM counter (map b "ffffffffttfftt")
  where b 't' = True
        b 'f' = False

   今回はここまで。つづく？