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

具体例を頑張ってみます．fixに無名関数を与えるか，名前をつけるかは見やすくなる方を独断で決めて使うことにします．

条件を満たす値の和（プログラミングGauche，p.72より）

リストの中から条件を満たす要素だけの和を求めてみます．普通なら条件を与える関数をc::Int->Boolとして

csum:: (Int->Bool)->[Int] -> Int
csum c = sum.filter c 

くらいでしょうか．あえてfixで書いて

csum:: (Int->Bool)->[Int]->Int
csum = fix $ \ f c ns -> if ns==[] then 0
                          else let h = head ns
                                   t = f c (tail ns) in
                               if c h then h + t else t

としてみます．試みに

csum (>0) [1,-2,3]

の展開を追いかけます．無名関数をgと置きます．

csum (>0) [1,-2,3]
= (fix g) (>0) [1,-2,3]
= g (fix g) (>0) [1,-2,3]
= 1 + (fix g) (>0) [-2,3]
= 1 + g (fix g) (>0) [-2,3]
= 1 + (fix g) (>0) [3]
= 1 + g (fix g) (>0) [3]
= 1 + 3 + (fix g) (>0) []
= 1 + 3 + 0 -- [] のときは(fix g)は関係しないので
            -- 結局fix gは評価されないという形は同じ
=4

というわけで．めでたく今までと同じ構造に落ち着きました．

偶数・奇数の判別（プログラミングGauche，p.72より）

これも単に2で割った余りを計算する，つまり

isodd::Int -> Bool
isodd  n = if n % 2 == 1 then True else False

isoven::Int -> Bool
iseven n = if n % 2 == 0 then True else False

ですむのですが，あえて再帰してみます．

sign::Int->Int
sign n | n < 0     = -1
       | otherwise = 1

oe::Int->Bool
oe b n | n==0      = b
       | otherwise = oe (not b) (n - (sign n))

isodd:: Int->Bool
isodd  = oe False

iseven:: Int->Bool
iseven = oe True 

signは符号に応じて1か-1を返すだけの関数で，本体はoe（odd/evenのつもり）です．0に一つずつ近づけていくときに，真偽を反転させて再帰的に呼び出していけば，0で呼び出したときの真偽で奇数・偶数かが判断できるというわけです．

もう同じパターンが続いてるので，あっさりoeをfix版にします．

oe = fix $ \f b n -> if n==0 then b 
                             else f (not b) (n - (sign n))

これでOK．このパターンの「再帰」はかなりシンプルに変換可能なことがわかります．

相互再帰を考える．

さて，プログラミングGaucheのp.72では，一個にはしないで二つに分けて書かれています．Haskell風に書けば

-- sign::Int->Int
-- sign n | n<0 = -1
--       | otherwise = 1

isodd':: Int->Bool
isodd'  n | n==0      = False 
          | otherwise = iseven' (n-(sign n))

iseven':: Int->Bool
iseven' n | n==0      = True
          | otherwise = isodd' (n-(sign n))

というようにできます．このように二つの関数が互いに依存して再帰してるケースはどうしましょうか．もちろんこのケースでは，関数をじっくりみれば，簡単に一つの関数に変換できるので，それも一つの方法ですが，もっと複雑に入り組んでる場合もあるかもしれません．

そこでいろいろ考えます．ものの論文とかを見ると，実にあっさり

let x = e(y)
    y = e'(x)
in (x,y)

は

(x,y) = fix $ \ ~(x,y)-> (e(y),e'(x))

となるとか書いてます．~は「遅延パターン」です．パターンマッチの際にはその中身が評価されるのですが，評価されると困るケースがあります．それを避けるための方策が「遅延パターン」です．実際，letでは（相互再帰させる際に）先に評価されると困りますので，遅延パターンにする必要があります（あんまり易しくないけどもやさしいHaskell入門4.4節，4.5節，こっちもなかなか難解だけどもITProの連載：「本物のプログラマはHaskellを使う」第8回 遅延評価の仕組み（3ページ目） | 日経 xTECH（クロステック））．

はたしてこれはどういうことなのでしょう．泥臭く考えます．関数に名前をつけます．

(x,y) = fix  g
        where g ~(x,y)= (e(y),e'(x))

さて，(x,y)を評価します．

(x,y) =  g (x,y) -- fix の定義
      =  (e(y),e'(x)) -- ここで遅延パターンなので
                      -- x,yは評価されないでそのまま進む

でてきました．ここで本質なのは遅延パターンです．もしここが遅延パターンではなかったら，xとyを評価することになります．ところが，(x,y)=g(x,y)なので，次もまたxとyを評価することになり，延々と繰り返す無限ループが現れます．

ポイントフリーなisodd/iseven

ということで，isodd/isevenの話に戻って，これをfixで書くには

isodd  = e  (iseven)
iseven = e' (isodd)

という形にできればよいということがわかります．

（追記：2008/06/18）以下，ポイントフリーにする必要はないどころか，何にもしないでも上の形にできることをご指摘いただいたので，ポイントフリーはあくまでも一つの方策ということで(^^;;パズルと計算練習ということでひとつ．

この形にするには少なくとも，isodd/isevenをポイントフリーにしておくと楽そうですので，まずはポイントフリーに変形しましょう．ガードをやめてif-then-elseの定義からスタートです．

sign n = if n>0 then  1 else -1
isodd  n = if (n==0) then False else iseven (n-(sign n))
iseven n = if (n==0) then True  else isodd  (n-(sign n))

signも含めてみんな同じ形です．if-then-elseなのですが，これを関数にしてしまいましょう．「プログラミングGaucheから得た」Schemeからのアイデアです

ifcond c t f = if c then t else f
sign n = ifcond (n>0) 1 (-1)
isodd  n = ifcond (n==0) False (iseven (n-sign(n)))
iseven n = ifcond (n==0) True  (isodd  (n-sign(n)))

まずはsignを考えてみます（実はsignをポイントフリーにする必要は実際はありませんが）．

sign n = ifcond (n>0) 1 (-1)
       = ifcond ((>0)n) 1 (-1)  -- n>0 は(>)0 nであり部分適用で(>0)nとできる
       = (ifcond.(>0)) n 1 (-1) -- 関数ifcondの第一引数に関数(>0)を合成する
                                -- ifcond.(>0) は三変数の関数となる

ここで，引数の順番を取り替えることを考えて，

sign =(\f a b c -> f b c a) (ifcond.(>0)) 1 (-1) 

とすると，ポイントフリーにはなります．しかし，isodd/isevenの定義では，(-1)に対応する部分がまた関数になってるので，この構造をそのまますぐ使えるとは思えません．定数を関数にするのは簡単ですが（定数関数，K Combinatorというらしいです），関数は定数にはできません．そこで天下り的ですが，次のような関数（S Combinator）を導入します．

s f g x = f x (g x)

ぶっちゃけた話，二変数関数fと一変数関数gをもってきて，

x-> (x, g(x)) -> f (x,g(x))

とする関数です．これを使うと

sign n = (ifcond.(>0)) n 1 (-1)
       = F n 1 (-1)     -- F = (ifcond.(>0)) とおいた．擬コードです．
       = (s F 1) n (-1) -- 1は\x->1という定数関数とみなします．
       = G n (-1)       -- G = s F 1 とおいた．(-1)は\x->(-1)という定数関数とみなします．
       = (G.id) n (-1)  -- G の第一引数に恒等関数id x =xを合成
       = s G.id (-1) n

となるので，定数関数を作るconst（const x n = x）を使って

sign  = s G.id (const (-1))
      = s (s F (const 1)) (const (-1))
      = s (s (ifcond.(>0)) (const 1)) (const (-1))

とポイントフリーにできます．これをふまえて

isodd  n = ifcond (n==0) False (iseven (n-(sign n)))

をポイントフリーにします．まずは，

n-(sign n) = (-) n (sign n)
           = s (-) sign n

ですので，

isodd  n = ifcond (n==0) False ((iseven.(s (-) sign)) n)

です．同じ形のsignがポイントフリーに整理できたのですから，全く同様にできるはずです．

isodd n  = ifcond (n==0) False ((even.(s (-) sign)) n)
         = ifcond.((==)0) n (const False) ((even.(s (-) sign)) n)
         = F n (const False) ((even.(s (-) sign)) n) -- F = (ifcond.((==)0))
         = s F (const False) n ((even.(s (-) sign)) n)
         = G n ((even.(s (-) sign)) n) -- G = s F (const False)
         = s G (even.(s (-) sign)) n
         = s (s F (const False)) (even.(s (-) sign)) n
         = s (s (ifcond.((==)0)) (const False)) (even.(s (-) sign)) n

よって，

isodd =  = s (s (ifcond.((==)0)) (const False)) (iseven.(s (-) sign))

とポイントフリーにできました．同様にして，isevenも変形します．

isodd  = s (s (ifcond.((==)0)) (const False)) (iseven.(s (-) sign)) 
iseven = s (s (ifcond.((==)0)) (const True))  (isodd. (s (-) sign))

相互再帰とfixによるisodd/iseven

ポイントフリーのisodd/isevenをじっくり見てると，違いはFalse/Trueとお互いに呼び合う部分だけなので，

oe b f = s (s (ifcond.((==)0)) (const b)) (f.(s (-) sign))
isodd  = (oe False) iseven
iseven = (oe True)  isodd

と整理できます．ここまでくると，fixに与える形は見えてきます．以上をまとめると

fix f = let x =f x in x
s f g x = f x (g x)

ifcond c t f = if c then t else f
sign   = s (s (ifcond.(>0)) (const 1)) (const (-1))
oe b f = s (s (ifcond.((==)0)) (const b)) (f.(s (-) sign))
(isodd, iseven) = fix $ \ ~(o,e) -> ((oe False) e, (oe True) o)

さらに，S Combinator「s f g」はControl.Applicativeで演算子<*>として定義されていて，

s f g = f <*> g

であり，fixはData.Functionにあるので

import Control.Applicative ((<*>)) -- s f g x = f x (g x)
import Data.Function (fix) -- fix f = let x =f x in x

ifcond c t f = if c then t else f
sign   = ( (ifcond.(>0)) <*> (const 1)) <*> (const (-1))
oe b f = ((ifcond.((==)0)) <*> (const b)) <*> (f.((-) <*> sign))
(isodd, iseven) = fix $ \ ~(o,e) -> ((oe False) e, (oe True) o)

とすることもできます．

追記(2008/06/21)：やっぱり・・・もっと単純でよかった

コメントでご指摘いただいて，簡潔なコードも提示いただいて，それで気がついたのですが，そもそもほとんど書き直す必要はない，ポイントフリー化する必然はありません．

(isodd,iseven) = fix $ \ ~(o,e) -> (\n -> if (n==0) then False else e (n-(signum n)),
                                    \n -> if (n==0) then True  else o (n-(signum n)))

そもそも，これで「fixで相互再帰」の構造は見えますね。ご指摘いただいたif-then-elseを論理演算に変更するのは・・全然気がつかなかった，というか一瞬ほうけてしまった(^^;;