ArrowLoop

さて、気分を変えて ArrowLoop をやります。論文に書いてある

loop f b = let (c,d) = f (b,d) in c

の意味が全く分からなくて Arrow の勉強が一ヶ月近く停滞していたのですが、id:MaD さんが素晴らしい解説 http://d.hatena.ne.jp/MaD/20070818 を書かれているので自分なりに写経します。loop を使って普通のループを作るには、引数として関数を一つ与えます。関数の型は (b,d) -> (c,d) のような入出力ともタプルとします。よくある図で示すと、タプルの後ろの引数がくるりと入力に繋がれる形をしています。

import Control.Arrow

nonsense (b, d) = (b + 1, d * 2)
-- *Main> loop nonsense 1
-- 2

-- このしようも無い例では、b + 1 だけが実行されて、d * 2 には何の効果
-- も無いようです。これではさすがに詰まらないので、b と d を入れ替えて
-- "たすきがけ"にしてみます。

nonsense' (b, d) = (d + 1, b * 2)
-- *Main> loop nonsense' 1
-- 3

-- 引数 1 -> b * 2 -> d + 1 -> 答え 3 の順に実行されているようです。
-- Haskell は非正格なので、実際は、
-- * 答えが欲しい！
-- * d + 1 が欲しい！ (loop の定義より、nonsense' のひとつめの解)
-- * d が欲しい！
-- * b * 2 が欲しい！ (loop の定義より、nonsense' のふたつめの解)
-- * b が欲しい！
-- * b に 1 が与えられる
-- と逆に引っ張られるように実行されてゆきます。この逆に引っ張られる感
-- じは妙に感じれますが、要するに Excel のセル計算の要領と同じです。
-- 次に 1, 1, 1,... と無限にある数字を出す方法です。

rep (b, d) = (d, b:d)
-- Main> take 5 (loop rep 1)
-- [1,1,1,1,1]

-- * d が欲しい (loop の定義より、rep のひとつめの解)
-- * b:d が欲しい (d = b:d なので)
-- * b:d は 1,1,1,1,... (ここ重要！)
-- * d は 1,1,1,1,...

-- なぜ d = b:d という定義が可能で、しかも 1,1,1,... を生むのかという
-- のは大切な話なので、take 5 d where d = 1:d などを味わいながら考える
-- と良いです。結局、関数の二番目の解を工夫すればループが書ける事が分
-- かります。次は 3, 2, 1, 0 です。

countdown (x, f) = (f x, cd)
    where cd 0 = [0]
          cd n = n : f (n - 1)                 

-- *Main> loop countdown 3
-- [3,2,1,0]

-- これは短いわりに激しく分かりにくいのでゆっくり味わいましょう。二番
-- 目の Arrow に値ではなく関数を渡しています。自分自身を参照する事無く
-- 再帰を定義する Y コンビネータというやつです。これは以下の単純な再帰
-- 関数を変形して作りました。右辺の down を f に変えただけです。

down 0 = [0]
down n = n : down (n - 1)

-- 練習として、末尾再帰版もやってみました。普通、再帰的に関数を定義す
-- ると。最初の例では[3,2,1,0] のような数列を求めるために以下のように
-- スタックを掘り進めて埋めて行くような作業になります。

-- down 3 = 3 : down 2 -- 掘り進める
--        = 3 : (2 : down 1) -- 掘り進める
--        = 3 : (2 : (1 : down 0)) -- 掘り進める
--        = 3 : (2 : (1 : [0])) -- 番兵発見
--        = 3 : (2 : [1, 0]) -- 合成
--        = 3 : [2, 1, 0] -- 合成
--        = [3, 2, 1, 0] -- 合成

-- これは簡潔に記述出来る一方で数が増えると大変無駄な話です(Haksell で
-- は理屈が違うとどこかで聞きましたが、正しい話は忘れました)。末尾再帰
-- を使うとストレートに答えを得る事が出来ます。末尾再帰を作るには、媒
-- 介変数が一つ余計に必要になります。

down_tail n = down_tail' n [0]
down_tail' 0 xs = xs
down_tail' n (x:xs) = down_tail' (n - 1) (x + 1:x:xs)
-- down_tail 3 = down_tail' 3 [0]
--             = down_tail' 2 [1, 0]
--             = down_tail' 1 [2, 1, 0]
--             = down_tail' 0 [3, 2, 1, 0]  -- 番兵発見
--             = [3, 2, 1, 0]

countdown_tail (x, f) = (f x [0], cd)
    where cd 0 xs = xs
          cd n (x:xs) = f (n - 1) (x + 1:x:xs)
-- *Main> loop countdown_tail 3
-- [3,2,1,0]

-- MaD さんの例ではさらにどんどんポイントフリーに変形して行くので真似
-- してcountdown を変形してみます。勿体無いですがパターンマッチを展開。
-- 丁寧に型をつけながら確認して行きます。

countdown_arrow' :: (Int, Int -> [Int]) -> ([Int], Int -> [Int])
countdown_arrow' = \(x, f) -> (f x, \n -> if n == 0 then [0] else n : f (n - 1))

-- 入力が (x, f) のタプル、出力もタプルでした。タプルの fst に注目しま
-- す。arrow 化すると、app を使って次のようになります。
countdown_answer :: (Int, Int -> [Int]) -> [Int] 
countdown_answer = snd &&& fst >>> app
-- *Main> countdown_answer (1, (:[0]))
-- [1,0]

-- 次にタプルの snd の \(x, f) -> \n -> n : f (n - 1) を arrow 化します。
-- (n - 1) => pred 1
-- f (n - 1) => pred >>> f
-- n : f (n - 1) => id &&& pred >>> f >>> uncurry (:)
-- f が真ん中なのを入力に持ってきます。
countdown_recursion :: (Int, Int -> [Int]) -> Int -> [Int]
countdown_recursion = snd >>> (pred >>>) >>> (id &&&) >>> (>>> uncurry (:))

-- 条件文は arrow に無いので自作します。
ifzero 0 = Left 0
ifzero x = Right x

-- という事で \(x, f) -> \n -> if n == 0 then [0] else n : f (n - 1) 
-- の arrow 化
countdown_function :: (Int, Int -> [Int]) -> Int -> [Int]
countdown_function = snd >>> (pred >>>) >>> (id &&&) >>> (>>> uncurry (:)) >>> (const [0] |||) >>> (ifzero >>>)

-- くっつける
countdown_arrow'' :: (Int, Int -> [Int]) -> ([Int], Int -> [Int])
countdown_arrow'' = countdown_answer &&& countdown_function

-- 参考までに、展開すると
countdown_arrow :: (Int, Int -> [Int]) -> ([Int], Int -> [Int])
countdown_arrow = (snd &&& fst >>> app) &&& (snd >>> (pred >>>) >>> (id &&&) >>> (>>> uncurry (:)) >>> (const [0] |||) >>> (ifzero >>>))

-- *Main> loop countdown_arrow 3
-- [3,2,1,0]

-- 感想: 超めんどうくさい。もう疲れて何も書きたくないが、妄想モードで
-- こういう事やってる意義を書く。ループを手続き的や関数的に書く方が簡
-- 単で分かりやすいのに、何故こんな事やってるのでしょうか？この先に何
-- が見えるのでしょうか？私はこの先にループの本当の姿があると思います。
-- 手続き的にループを書くのは天動説のような物です。つまり、こうあって
-- 欲しい姿と、本当の姿を取り違えている。天動説は、普段の空の動きを記
-- 述するのに充分ですが、天動説に囚われる事で本当の答えの妨げになって
-- しまいます。

-- ループのような人工的な概念にも「本当の姿」があるとしたら、それはちょっ
-- と意外な事で、受け入れがたい物かも知れません。しかしすでに私たちは
-- 確率や集合で、直感と数学的な事実がかみ合わない事をよく知っています。
-- arrow は(というかコンビネータは)私たちの知っている概念を最小の原子
-- にまで分解して再構成します。全然別だと思っていた事実に意外な共通点
-- を見つける良い方法です。その過程でループも、本当はもっと広い概念の
-- 一部だとしたらどうでしょうか。Joy のループが dup だけで書かれている
-- のを見た時に、ループが私の全然知らない姿をしていた事にびっくりした
-- のです。ループを手続き的にだけ見るのは、鯨を魚と思うような表面的な
-- 考えです。コンビネータの分子に分解すると、もっと面白くて役に立つ世
-- 界が広がっています。生きてて良かった。