めもめも

このブログに記載の内容は個人の見解であり、必ずしも所属組織の立場、戦略、意見を代表するものではありません。

ZipListは本当にMonadから構成できないのか?

先のエントリで、直感的な憶測から『「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を付与するような技巧が不要になります。すばらしい。2箇所の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]