先のエントリで、直感的な憶測から『「Monadプローブ結合方式」で、ZipListの<*>演算を実現することはできません』と書いたのですが、本当に不可能なのかじっくり考えてみました。
実は、工夫すれば、MonadからZipListを構成できる気がしてきました。。。。（やはり下手な直感に頼ってはいけませんね。"good intuition comes from hard work, not from learning the right metaphor."）
リストの長さを考慮しないパターン
以下は、ZipList（MyZipList）をMonadから構成する例です。ただし、後述のようにリストの長さを考慮しないという欠点があります。
myziplist.hs
import Control.Monad import Control.Applicative newtype MyZipList a = MyZipList [a] deriving (Show) elemAt :: MyZipList a -> Int -> a (MyZipList xs) `elemAt` i = xs !! i instance Functor MyZipList where fmap f (MyZipList xs) = MyZipList (map f xs) instance Monad MyZipList where return x = MyZipList $ repeat x h >>= f = MyZipList $ map g [0,1..] where g = \i -> (f(h `elemAt` i)) `elemAt` i instance Applicative MyZipList where pure = return mf <*> mx = do f <- mf x <- mx return $ f x
実行例はこんな感じ。
$ ghci myziplist.hs GHCi, version 7.4.2: http://www.haskell.org/ghc/ :? for help Loading package ghc-prim ... linking ... done. Loading package integer-gmp ... linking ... done. Loading package base ... linking ... done. [1 of 1] Compiling Main ( myziplist.hs, interpreted ) Ok, modules loaded: Main. *Main> (+) <$> MyZipList[2,3,4] <*> MyZipList[1,2,3] MyZipList [3,5,7,*** Exception: Prelude.(!!): index too large *Main> (^) <$> MyZipList[2,3,4] <*> MyZipList[1,2,3] MyZipList [2,9,64,*** Exception: Prelude.(!!): index too large
演算結果がすべて無限リストであることを想定しているので、上記のように有限リストを与えた場合は、リストの長さを超えたところでExceptionとなります。この点を除けば、正しくZipListが再現されています。
念のためMonad則も確認するとこのような感じです。
*Main> let f = \x -> MyZipList [x*1, x*2, x*3, x*4, x*5] *Main> let g = \x -> MyZipList [x+1, x+2, x+3] *Main> MyZipList [1,2..] >>= f MyZipList [1,4,9,16,25,*** Exception: Prelude.(!!): index too large *Main> (MyZipList [1,2..] >>= f ) >>= g MyZipList [2,6,12,*** Exception: Prelude.(!!): index too large *Main> MyZipList [1,2..] >>= (\x -> (f x >>= g)) MyZipList [2,6,12,*** Exception: Prelude.(!!): index too large
では、どういう発想でこれを作ったのか説明します。ヒントは関数Monadからの類推です。
下記は関数Monadの定義です。
instance Monad ((->) r) where return x = \_ -> x h >>= f = \r -> f (h r) $ r
ここで、関数の引数「r」を整数に限定して、これをリストのindexとみなします。そう、リストは関数の特殊な場合なんですよね。
というわけで、上記の関数Monadの定義の引数「r」をリストのindexに置き換えて再定義したのが、先のMonadの定義部分（下記）になります。
instance Monad MyZipList where return x = MyZipList $ repeat x h >>= f = MyZipList $ map g [0,1..] where g = \i -> (f(h `elemAt` i)) `elemAt` i
リストの長さを考慮するパターン
それでは、有限リストの際にきちんと後半のundefined部分をカットすることはできないでしょうか？ ―― なんと！3時間ほどがんばったらできました・・・。
myziplist2.hs
{-# LANGUAGE ScopedTypeVariables #-} import Control.Monad import Control.Applicative newtype MyZipList a = MyZipList [a] deriving (Show) elemAt :: MyZipList a -> Int -> a (MyZipList xs) `elemAt` i = xs !! i addBottom :: MyZipList a -> MyZipList (Maybe a) addBottom (MyZipList xs) = MyZipList $ map Just xs ++ repeat Nothing delBottom :: MyZipList (Maybe a) -> MyZipList a delBottom (MyZipList xs) = MyZipList $ delBottom' [] xs where delBottom' res (x:xs) = case x of Nothing -> res Just i -> delBottom' (res ++ [i]) xs mytake :: Int -> MyZipList a -> MyZipList a mytake n (MyZipList xs) = MyZipList $ take n xs instance Functor MyZipList where fmap f (MyZipList xs) = MyZipList (fmap f xs) instance Monad MyZipList where return x = MyZipList $ repeat x (h :: MyZipList a) >>= (f :: a -> MyZipList b) = delBottom $ MyZipList $ map g [0,1..] where f' :: Maybe a -> MyZipList (Maybe b) f' x = case x of Nothing -> addBottom $ MyZipList [] Just i -> addBottom $ f(i) g :: Int -> Maybe b g = \i -> (f'((addBottom h) `elemAt` i)) `elemAt` i instance Applicative MyZipList where pure = return mf <*> mx = do f <- mf x <- mx return $ f x
先の例と同じ計算をしてみます。
$ ghci myziplist2.hs GHCi, version 7.0.4: http://www.haskell.org/ghc/ :? for help Loading package ghc-prim ... linking ... done. Loading package integer-gmp ... linking ... done. Loading package base ... linking ... done. [1 of 1] Compiling Main ( myziplist2.hs, interpreted ) Ok, modules loaded: Main. *Main> let f = \x -> MyZipList [x*1, x*2, x*3, x*4, x*5] *Main> let g = \x -> MyZipList [x+1, x+2, x+3] *Main> MyZipList [1,2..] >>= f MyZipList [1,4,9,16,25] *Main> (MyZipList [1,2..] >>= f ) >>= g MyZipList [2,6,12] *Main> MyZipList [1,2..] >>= (\x -> (f x >>= g)) MyZipList [2,6,12]
うまくいってますね。
実際、何をやっているかというと、(>>=)演算を行う際に、有限リストを一旦、次の様な無限リストに変換しています。
addBottom : MyZipList[1,2,3] |-> MyZipList[Maybe 1, Maybe 2, Maybe 3, Nothing, Nothing..]
これは、リスト内の型aをMaybe型に昇格させて、後ろのundefined(Bottom)の部分には、明示的にNothingを埋め込んでいます。つまり、[a]の有限リストの計算を[Maybe a]の無限リストの計算に置き換えているわけです。
で、無限リストとしての計算が終わったら、再び、後半のNothingを取り除いて有限リストに戻しています。
delBottom : MyZipList[Maybe 1, Maybe 2, Maybe 3, Nothing, Nothing..] |-> MyZipList[1,2,3]
実際に様子を確認すると、こんな感じです
*Main> mytake 5 $ addBottom $ MyZipList [1,2,3] MyZipList [Just 1,Just 2,Just 3,Nothing,Nothing] *Main> delBottom $ addBottom $ MyZipList [1,2,3] MyZipList [1,2,3]
いやー。Monadは侮ってはいけませんねー。
再帰的な定義の例
追記です。先の私の定義では、本質的には、
map g [0,1..] where g = \i -> (f(h `elemAt` i)) `elemAt` i
という演算でMatrix [(f h_i)_j] (i,j=0,1,...)の対角線要素を取り出しているわけですが、「再帰的にとり出せばいいじゃない？」という指摘をいただきました。次のような感じです。
import Control.Monad newtype MyZipList a = MyZipList [a] deriving (Show) getBase :: MyZipList a -> [a] getBase (MyZipList xs) = xs instance Monad MyZipList where return x = MyZipList $ repeat x m >>= f = MyZipList $ bind (getBase m) (fmap getBase f) where bind :: [a] -> (a -> [b]) -> [b] bind [] f = [] bind (x:xs) f = case f x of [] -> [] y:_ -> y : bind xs (fmap tailOrNil f) tailOrNil :: [b] -> [b] tailOrNil [] = [] tailOrNil (x:xs) = xs
この方法だと、有限リストに対して再帰の途中で明示的に計算を打ちきれるので、Maybeに昇格してNothingを付与するような技巧が不要になります。すばらしい。２箇所のfmapは、「Functor ((->) r)」に対するfmapですが、特に、「fmap tailOrNil f」で関数側のtailを取って再帰するあたりがうまいですね。
実は、先の定義（myziplist2.hs）では、有限リストはうまく行くのですが、逆に無限リストの際にdelBottomがループするという問題があります。
*Main> let f = \x -> MyZipList $ repeat (x*2) *Main> mytake 3 $ MyZipList [1,2..] >>= f MyZipList <---- 終わらない
こちらの方法だと、このような問題も発生しません。ちょっと悔しかったので、ループしないようにdelBottomを書きなおしたものを再掲しておきます。
myziplist3.hs
{-# LANGUAGE ScopedTypeVariables #-} import Control.Monad import Control.Applicative newtype MyZipList a = MyZipList [a] deriving (Show) elemAt :: MyZipList a -> Int -> a (MyZipList xs) `elemAt` i = xs !! i appendTo :: MyZipList a -> [a] -> MyZipList a appendTo (MyZipList xs) ys = MyZipList $ xs ++ ys addBottom :: MyZipList a -> MyZipList (Maybe a) addBottom (MyZipList xs) = MyZipList $ map Just xs ++ repeat Nothing delBottom :: MyZipList (Maybe a) -> MyZipList a delBottom (MyZipList xs) = (MyZipList []) `appendTo` (delBottom' xs) where delBottom' (x:xs) = case x of Nothing -> [] Just i -> [i] ++ (delBottom' xs) mytake :: Int -> MyZipList a -> MyZipList a mytake n (MyZipList xs) = MyZipList $ take n xs instance Functor MyZipList where fmap f (MyZipList xs) = MyZipList (fmap f xs) instance Monad MyZipList where return x = MyZipList $ repeat x (h :: MyZipList a) >>= (f :: a -> MyZipList b) = delBottom $ MyZipList $ map g [0,1..] where f' :: Maybe a -> MyZipList (Maybe b) f' x = case x of Nothing -> addBottom $ MyZipList [] Just i -> addBottom $ f(i) g :: Int -> Maybe b g = \i -> (f'((addBottom h) `elemAt` i)) `elemAt` i instance Applicative MyZipList where pure = return mf <*> mx = do f <- mf x <- mx return $ f x
さらに追記
haskell-cafeに投げてみたら、みごとに反例が返ってきました。 (^^;;
http://www.haskell.org/pipermail/haskell-cafe/2013-October/111004.html
http://www.haskell.org/pipermail/haskell-cafe/2013-October/111020.html
http://www.haskell.org/pipermail/haskell-cafe/2013-October/111032.html
例えば、下記の例では、Monad則が成り立ちませんね。
f x = case x of 1 -> MyZipList [1,0,0] 2 -> MyZipList [0,2,0] 3 -> MyZipList [0,0,3] otherwise -> MyZipList [] MyZipList [1,2,3] >>= f >>= f MyZipList [1,2,3] MyZipList [1,2,3] >>= \x -> (f x >>= f) MyZipList [1]
やはり、「前から計算して途中で打ち切る」という逐次操作的な発想が合わないのかも知れません。代替策としては、最初の無限リストを対象とした「静的」な定義にもどって、その代わりに、「要素をMaybe型に限定して、値を持たない部分はNothingで表現する」という規約が考えられます。
import Control.Monad newtype MyZipList a = MyZipList [a] deriving (Show) mytake :: Int -> MyZipList a -> [a] mytake n (MyZipList xs) = take n xs elemAt :: MyZipList a -> Int -> a (MyZipList xs) `elemAt` i = xs !! i mkMyZipList :: [a] -> MyZipList (Maybe a) mkMyZipList xs = MyZipList $ map Just xs ++ repeat Nothing instance Monad MyZipList where return x = MyZipList $ repeat x h >>= f = MyZipList $ map g [0,1..] where g = \i -> (f(h `elemAt` i)) `elemAt` i f x = case x of Just 1 -> mkMyZipList [1,0,0] Just 2 -> mkMyZipList [0,2,0] Just 3 -> mkMyZipList [0,0,3] otherwise -> mkMyZipList []
これであれば、次のようにうまく行きます。
*Main> let a = mkMyZipList [1,2,3] *Main> mytake 5 $ a >>= f >>= f [Just 1,Just 2,Just 3,Nothing,Nothing] *Main> mytake 5 $ a >>= \x -> (f x >>= f) [Just 1,Just 2,Just 3,Nothing,Nothing]
