モナド変換子の続きです。今回は状態系のモナド変換子 WriterT, ReaderT, StateT について説明します。
まずは最初に、WriterT から説明しましょう。WriterT は Writer のモナド変換子で、モジュール Control.Monad.Writer.Lazy に定義されています。データ型は WriterT w m a で、w がログを表すデータ型 (モノイド)、m がモナド、a が値を表すデータ型です。WriterT は (a, w) をモナド m で包んだ m (a, w) になります。
簡単な実行例を示します。
Prelude> :m + Control.Monad
Prelude ...> :m + Control.Monad.Writer.Lazy
Prelude ...> runWriterT (return 1 :: WriterT String Maybe Int)
Just (1,"")
Prelude ...> runWriterT (return 1 :: WriterT String [] Int)
[(1,"")]
Prelude ...> runWriterT (return 1 :: WriterT String IO Int)
(1,"")
Prelude ...> runWriterT $ (return 1 :: WriterT String Maybe Int) >>= \x -> tell("oops") >> return (x * 2)
Just (2,"oops")
Prelude ...> runWriterT $ (return 1 :: WriterT String [] Int) >>= \x -> tell("oops") >> return (x * 2)
[(2,"oops")]
Prelude ...> runWriterT $ (return 1 :: WriterT String IO Int) >>= \x -> tell("oops") >> return (x * 2)
(2,"oops")
Prelude ...> runWriterT $ (return 1 :: WriterT String IO Int) >>= \x -> liftIO(print "oops") >> return (x * 2)
"oops"
(2,"")
Prelude ...> runWriterT $ (fail "" :: WriterT String Maybe Int) >>= \x -> tell("oops") >> return (x * 2)
Nothing
Prelude ...> runWriterT $ (fail "" :: WriterT String [] Int) >>= \x -> tell("oops") >> return (x * 2)
[]
Prelude ...> runWriterT $ (return 1 :: WriterT String Maybe Int) `mplus` return 2
Just (1,"")
Prelude ...> runWriterT $ (mzero :: WriterT String Maybe Int) `mplus` return 2
Just (2,"")
Prelude ...> runWriterT $ (mzero :: WriterT String Maybe Int) `mplus` mzero
Nothing
Prelude ...> runWriterT $ (return 1 :: WriterT String [] Int) `mplus` return 2
[(1,""),(2,"")]
Prelude ...> runWriterT $ (mzero :: WriterT String [] Int) `mplus` return 2
[(2,"")]
Prelude ...> runWriterT $ (mzero :: WriterT String [] Int) `mplus` mzero
[]
WriterT は Writer をモナドに包んだものなので、Writer モナドの定義とよく似ています。次のリストを見てください。
リスト : Writer モナドの定義
-- データ型の定義
newtype Writer w a = Writer {runWriter :: (a, w)}
-- インスタンスの設定
instance Monoid w => Monad (Writer w) where
return x = Writer (x, mempty)
(Writer (x, v)) >>= f = let Writer (y, v') = f x
in Writer (y, v `mappend` v')
リスト : モナド変換子 WriterT
newtype WriterT w m a = WriterT {runWriterT :: m (a, w)}
instance (Monoid w, Monad m) => Monad (WriterT w m) where
return x = WriterT $ return (x, mempty)
m >>= k = WriterT $ do (y, v) <- runWriterT m
(z, v') <- runWriterT (k y)
return (z, v `mappend` v')
fail s = WriterT $ fail s
-- ログの書き込み
tell :: (Monoid w, Monad m) => w -> WriterT w m ()
tell s = WriterT $ return ((), s)
return x は (x, empty) をモナドに包んで返します。バインド演算子は、最初にモナド m から値とログ (y, v) を取り出します。次に、値 y を関数 k に適用して、その値とログ (z, v') を取り出します。あとは、ログ v, v' を mappend で結合して、z と一緒にモナドに包んで返します。
ログを書き込む tell も簡単です。引数 s をタプル ((), s) に格納し、それをモナドに包んで返すだけです。ここではプログラムを簡単にするため、tell を関数として定義しています。
WriterT の Functor は簡単です。次のリストを見てください。
リスト : WriterT の Functor
instance Monad m => Functor (WriterT w m) where
fmap f x = WriterT $ do (a, w) <- runWriterT x
return (f a, w)
fmap はモナド x に格納されている値 a に関数 f を適用するだけです。ログ w はそのままとします。
簡単な実行例を示します。
Prelude ...> runWriterT $ fmap (*2) (return 1 :: WriterT String [] Int) [(2,"")] Prelude ...> runWriterT $ fmap (*2) (return 1 :: WriterT String IO Int) (2,"") Prelude ...> runWriterT $ fmap (*2) (return 1 :: WriterT String Maybe Int) Just (2,"")
lift 関数と MonadPlus の定義も簡単です。
リスト : WriterT の lift 関数と MonadPlus instance Monoid w => MonadTrans (WriterT w) where lift m = WriterT $ m >>= (\x -> return (x, mempty)) instance (Monoid w, MonadIO m) => MonadIO (WriterT w m) where liftIO = lift . liftIO instance (Monoid w, MonadPlus m) => MonadPlus (WriterT w m) where mzero = WriterT mzero x `mplus` y = WriterT $ runWriterT x `mplus` runWriterT y
lift はモナド m から値 x を取り出して、それをタプル (x, mempty) にまとめてモナドに包んで返します。ログは mempty とします。WriterT の MonadPlus は MonadPlus m の mzero, mplus を呼び出すだけです。
簡単な実行例を示します。
Prelude ...> runWriterT $ (return 1 :: WriterT String IO Int) >>= \x -> lift(print "oops") >> return (x*2) "oops" (2,"") Prelude ...> runWriterT $ (return 1 :: WriterT String IO Int) >>= \x -> liftIO(print "oops") >> return (x*2) "oops" (2,"") Prelude ...> runWriterT $ (return 1 :: WriterT String Maybe Int) `mplus` (return 2) Just (1,"") Prelude ...> runWriterT $ (mzero :: WriterT String Maybe Int) `mplus` (return 2) Just (2,"") Prelude ...> runWriterT $ (mzero :: WriterT String Maybe Int) `mplus` mzero Nothing Prelude ...> runWriterT $ (return 1 :: WriterT String [] Int) `mplus` (return 2) [(1,""),(2,"")] Prelude ...> runWriterT $ (mzero :: WriterT String [] Int) `mplus` (return 2) [(2,"")] Prelude ...> runWriterT $ (mzero :: WriterT String [] Int) `mplus` mzero []
それでは簡単な例題として、拙作のページ モナド (2) で作成したフィボナッチ関数の呼び出し履歴を求めるプログラムで、履歴を画面へ出力するように修正してみましょう。
リスト : フィボナッチ関数の履歴
type WriterIO w a = WriterT w IO a
fibo :: Int -> WriterIO [String] Int
fibo n = do
let s1 = "fibo " ++ show n ++ " called"
tell [s1]
liftIO (print s1)
if n < 2 then do
let s2 = "fibo " ++ show n ++ " = 1"
tell [s2]
liftIO (print s2)
return 1
else do
a <- fibo (n - 1)
b <- fibo (n - 2)
let s3 = "fibo " ++ show n ++ "= " ++ show (a + b)
tell [s3]
liftIO (print s3)
return (a + b)
プログラムは簡単です。type で WriterT w IO a に別名 WriterIO w a をつけます。関数 fibo の返り値のデータ型は WriterIO [String] Int になります。あとは、liftIO でログに追加する文字列を print で画面に出力するだけです。
それでは実行してみましょう。
*Main> runWriterT $ fibo 4 "fibo 4 called" "fibo 3 called" "fibo 2 called" "fibo 1 called" "fibo 1 = 1" "fibo 0 called" "fibo 0 = 1" "fibo 2= 2" "fibo 1 called" "fibo 1 = 1" "fibo 3= 3" "fibo 2 called" "fibo 1 called" "fibo 1 = 1" "fibo 0 called" "fibo 0 = 1" "fibo 2= 2" "fibo 4= 5" (5,["fibo 4 called","fibo 3 called","fibo 2 called","fibo 1 called","fibo 1 = 1", "fibo 0 called","fibo 0 = 1","fibo 2= 2","fibo 1 called","fibo 1 = 1","fibo 3=3", "fibo 2 called","fibo 1 called","fibo 1 = 1","fibo 0 called","fibo 0 = 1","fibo 2= 2","fibo 4= 5"])
正常に動作していますね。
次は ReaderT について説明します。ReaderT はモジュール Control.Monad.Reader に定義されています。データ型は ReaderT r m a で、m がモナドを表します。Reader r a は関数 r -> a を格納したものです。ReaderT r m a は関数 r -> a をモナド m で包むのではなく、返り値 a だけをモナド m で包みます。つまり、m (r -> a) ではなく、r -> m a になることに注意してください。
簡単な例を示します。
Prelude> :m + Control.Monad.Reader Prelude ...> runReaderT (return 1 :: ReaderT Int Maybe Int) 0 Just 1 Prelude ...> runReaderT (return 1 :: ReaderT Int [] Int) 0 [1] Prelude ...> runReaderT (return 1 :: ReaderT Int IO Int) 0 1 Prelude ...> runReaderT ((ask :: ReaderT Int Maybe Int) >>= \x -> return (x + 10)) 0 Just 10 Prelude ...> runReaderT ((ask :: ReaderT Int [] Int) >>= \x -> return (x + 10)) 0 [10] Prelude ...> runReaderT ((ask :: ReaderT Int IO Int) >>= \x -> return (x + 10)) 0 10 Prelude ...> runReaderT ((fail "" :: ReaderT Int Maybe Int) >>= \x -> return (x + 10)) 0 Nothing Prelude ...> runReaderT ((fail "" :: ReaderT Int [] Int) >>= \x -> return (x + 10)) 0 [] Prelude ...> runReaderT ((ask :: ReaderT Int Maybe Int) `mplus` return 1) 0 Just 0 Prelude ...> runReaderT ((mzero :: ReaderT Int Maybe Int) `mplus` return 1) 0 Just 1 Prelude ...> runReaderT ((mzero :: ReaderT Int Maybe Int) `mplus` mzero) 0 Nothing Prelude ...> runReaderT ((ask :: ReaderT Int [] Int) `mplus` return 1) 0 [0,1] Prelude ...> runReaderT ((mzero :: ReaderT Int [] Int) `mplus` return 1) 0 [1] Prelude ...> runReaderT ((mzero :: ReaderT Int [] Int) `mplus` mzero) 0 []
ReaderT の定義は次のようになります。
リスト : Reader モナドの定義
-- データ型の定義
newtype Reader e a = Reader {runReader :: e -> a}
-- インスタンスの設定
instance Monad (Reader e) where
return x = Reader $ \_ -> x
(Reader f) >>= g = Reader $ \e -> runReader (g (f e)) e
ask :: Reader a a
ask = Reader id
local :: (e -> e) -> Reader e a -> Reader e a
local f c = Reader $ \e -> runReader c (f e)
リスト : ReaderT の定義
newtype ReaderT r m a = ReaderT {runReaderT :: r -> m a}
instance Monad m => Monad (ReaderT r m) where
return x = ReaderT $ \_ -> return x
m >>= k = ReaderT $ \r -> do a <- runReaderT m r
runReaderT (k a) r
fail s = ReaderT $ \_ -> fail s
ask :: Monad m => ReaderT a m a
ask = ReaderT return
local :: Monad m => (e -> e) -> ReaderT e m a -> ReaderT e m a
local f c = ReaderT $ \e -> runReaderT c (f e)
Reader の return x は Reader $ \_ -> x でした。ReaderT は返り値をモナドに包めばよいので、ReaderT $ \_ -> return x となります。バインド演算子は runReaderT m r でモナド m に r を渡して評価し、do 構文の <- でモナドから値を取り出して変数 a にセットします。k a の返り値は ReaderT 型になるので、runReaderT で関数を取り出して引数 r に適用します。fail は引数 s をモナド m の fail に渡すだけです。
関数 ask も簡単です。return で引数をモナドに包み、それを ReaderT に格納するだけです。local は引数 e に関数 f を適用して環境を更新し、それに runReaderT c を適用します。ここではプログラムを簡単にするため、ask と local を関数として定義しています。
ReaderT も Functor を定義することができます。次のリストを見てください。
リスト : ReaderT の Functor
instance (Monad m) => Functor (ReaderT r m) where
fmap f x = ReaderT $ \r -> do a <- runReaderT x r
return (f a)
runReaderT でモナド x に引数 r を与えて、その返り値を変数 a に受け取ります。あとは、変数 a に関数 f を適用して、その返り値を return でモナドに包んで返します。
簡単な実行例を示します。
Prelude ...> runReaderT (fmap (*2) (ask :: ReaderT Int IO Int)) 1 2 Prelude ...> runReaderT (fmap (*2) (ask :: ReaderT Int [] Int)) 1 [2] Prelude ...> runReaderT (fmap (*2) (ask :: ReaderT Int Maybe Int)) 1 Just 2
lift 関数と MonadPlus の定義も簡単です。
リスト : ReaderT の lift 関数と MonadPlus instance MonadTrans (ReaderT r) where lift m = ReaderT $ \_ -> m instance (MonadIO m) => MonadIO (ReaderT r m) where liftIO = lift . liftIO instance MonadPlus m => MonadPlus (ReaderT r m) where mzero = ReaderT $ \_ -> mzero x `mplus` y = ReaderT $ \r -> runReaderT x r `mplus` runReaderT y r
ReaderT のデータ型は r -> m a なので、lift はモナド m をラムダ式に包んで返すだけで実現できます。ReaderT の MonadPlus は MonadPlus m の mzero, mplus を呼び出すだけです。
簡単な実行例を示します。
Prelude ...> runReaderT ((ask :: ReaderT Int IO Int) >>= \x -> lift(print x) >> return (x * 2)) 10 10 20 Prelude ...> runReaderT ((ask :: ReaderT Int IO Int) >>= \x -> liftIO(print x) >> return (x * 2)) 10 10 20 Prelude ...> runReaderT ((ask :: ReaderT Int Maybe Int) `mplus` ask) 10 Just 10 Prelude ...> runReaderT ((mzero :: ReaderT Int Maybe Int) `mplus` ask) 10 Just 10 Prelude ...> runReaderT ((mzero :: ReaderT Int Maybe Int) `mplus` mzero) 10 Nothing Prelude ...> runReaderT ((ask :: ReaderT Int [] Int) `mplus` ask) 10 [10,10] Prelude ...> runReaderT ((ask :: ReaderT Int [] Int) `mplus` mzero) 10 [10] Prelude ...> runReaderT ((mzero :: ReaderT Int [] Int) `mplus` mzero) 10 []
それでは簡単な例題として、ReaderT モナドを使って果物の値段を求めるプログラムを作りましょう。次のリストを見てください。
リスト : 果物の値段を求める
import Control.Monad.Reader
type ReaderMaybe r a = ReaderT r Maybe a
data Fruit = Apple | Grape | Orange | Peach deriving (Show, Eq)
type Price = (Fruit, Int)
priceList :: [Price]
priceList = [(Apple, 100), (Grape, 150), (Orange, 200)]
lookupPrice :: Fruit -> ReaderMaybe [Price] Int
lookupPrice x =
ask >>= \ps -> case lookup x ps of
Nothing -> fail ""
Just v -> return v
最初に、type で ReaderT r Maybe a の別名 ReaderMaybe r a をつけます。次に、果物を表すデータ型 Fruit と果物の値段を表すデータ型 Price を定義します。果物の値段は連想リスト priceList に定義します。関数 lookupPrice は果物 x の値段を求めます。ask で環境の値 ps を求め、関数 lookup で果物 x の値段を ps から探索します。見つけた場合は値 v を return でモナド (Maybe) に包んで返します。そうでなければ、fail で Nothing を返します。
簡単な実行例を示します。
*Main> runReaderT (lookupPrice Apple) priceList Just 100 *Main> runReaderT (lookupPrice Grape) priceList Just 150 *Main> runReaderT (lookupPrice Orange) priceList Just 200 *Main> runReaderT (lookupPrice Peach) priceList Nothing
Peach は priceList に定義されていないので、返り値は Nothing になります。
次は StateT について説明します。StateT は State のモナド変換子で、モジュール Control.Monad.State に定義されています。データ型は StateT s m a で、s が状態を表すデータ型、m がモナド、a が値を表します。State s a は関数 s -> (a, s) を格納したものですが、StateT s m a は関数 s -> (a, s) をモナド m で包むのではなく、返り値 (a, s) だけをモナド m で包みます。つまり、m (s -> (a, s)) ではなく、s -> m (a, s) になることに注意してください。
簡単な例を示しましょう。
Prelude> :m + Control.Monad.State Prelude ...> runStateT (return 1 :: StateT Int Maybe Int) 0 Just (1,0) Prelude ...> runStateT (return 1 :: StateT Int [] Int) 0 [(1,0)] Prelude ...> runStateT (return 1 :: StateT Int IO Int) 0 (1,0) Prelude ...> runStateT ((get :: StateT Int Maybe Int) >>= \x -> return (x * 2)) 1 Just (2,1) Prelude ...> runStateT ((get :: StateT Int [] Int) >>= \x -> return (x * 2)) 1 [(2,1)] Prelude ...> runStateT ((get :: StateT Int IO Int) >>= \x -> return (x * 2)) 1 (2,1) Prelude ...> runStateT ((fail "" :: StateT Int Maybe Int) >>= \x -> return (x * 2)) 1 Nothing Prelude ...> runStateT ((fail "" :: StateT Int [] Int) >>= \x -> return (x * 2)) 1 [] Prelude ...> runStateT ((get :: StateT Int Maybe Int) `mplus` return 2) 1 Just (1,1) Prelude ...> runStateT ((mzero :: StateT Int Maybe Int) `mplus` return 2) 1 Just (2,1) Prelude ...> runStateT ((mzero :: StateT Int Maybe Int) `mplus` mzero) 1 Nothing Prelude ...> runStateT ((get :: StateT Int [] Int) `mplus` return 2) 1 [(1,1),(2,1)] Prelude ...> runStateT ((mzero :: StateT Int [] Int) `mplus` return 2) 1 [(2,1)] Prelude ...> runStateT ((mzero :: StateT Int [] Int) `mplus` mzero) 1 []
StateT の定義は次のようになります。
リスト : State モナドの定義
-- データ型の定義
newtype State s a = State {runState :: s -> (a, s)}
-- インスタンスの設定
instance Mmonad (State s) where
return x = State $ \s -> (x, s)
(State f) >>= g = State $ \s -> let (x, s1) = f s
in runState (g x) s1
-- 状態を取得する
get :: State s s
get = State $ \s -> (s, s)
-- 状態を更新する
put :: s -> State s ()
put s = State $ \_ -> ((), s)
リスト : モナド変換子 StateT の定義
newtype StateT s m a = StateT {runStateT :: s -> m (a, s)}
instance Monad m => Monad (StateT s m) where
return x = StateT $ \s -> return (x, s)
m >>= k = StateT $ \s -> do (a, s') <- runStateT m s
runStateT (k a) s'
fail s = StateT $ \_ -> fail s
-- 状態を取得する
get :: Monad m => StateT s m s
get = StateT $ \s -> return (s, s)
-- 状態を更新する
put :: Monad m => s -> StateT s m ()
put s = StateT $ \_ -> return ((), s)
State の return x は State $ \s -> (x, s) でした。StateT は返り値をモナドに包めばよいので、StateT $ \s -> return (x, s) となります。バインド演算子は runStateT m s でモナド m に s を渡して評価し、do 構文の <- でモナドから値を取り出して変数 (a, s') にセットします。k a の返り値は StateT 型になるので、runStateT で関数を取り出して新しい状態 s' に適用します。fail は引数 s をモナド m の fail に渡すだけです。
get, put は簡単です。get はラムダ式に渡された状態 s をタプルに格納してモナドに包んで返すだけです。put はラムダ式に渡された状態を無視して、引数 s を新しい状態としてタプルに格納してモナドに包んで返します。なお、プログラムを簡単にするため、get, put は関数として定義しています。
StateT も Functor を定義することができます。次のリストを見てください。
リスト : StateT の Functor
instance (Monad m) => Functor (StateT s m) where
fmap f x = StateT $ \s -> do (a, s') <- runStateT x s
return (f a, s')
runStateT でモナド x に引数 s を与えて、その返り値と新しい状態を変数 a と s' に受け取ります。あとは、変数 a に関数 f を適用して、その返り値と s' を return でモナドに包んで返します。
簡単な実行例を示します。
Prelude ...> runStateT (fmap (*2) (return 1 :: StateT Int [] Int)) 0 [(2,0)] Prelude ...> runStateT (fmap (*2) (return 1 :: StateT Int Maybe Int)) 0 Just (2,0) Prelude ...> runStateT (fmap (*2) (return 1 :: StateT Int IO Int)) 0 (2,0)
lift 関数と MonadPlus の定義も簡単です。
リスト : StateT の lift 関数と MonadPlus
instance MonadTrans (StateT s) where
lift m = StateT $ \s -> do a <- m
return (a, s)
instance (MonadIO m) => MonadIO (StateT s m) where
liftIO = lift . liftIO
instance MonadPlus m => MonadPlus (StateT s m) where
mzero = StateT $ \_ -> mzero
x `mplus` y = StateT $ \s -> runStateT x s `mplus` runStateT y s
lift はモナド m から値 a を取り出して、それをタプル (a, s) にまとめてモナドに包んで返します。StateT の MonadPlus は MonadPlus m の mzero, mplus を呼び出すだけです。
簡単な実行例を示します。
Prelude ...> runStateT ((get :: StateT [Int] IO [Int]) >>= \a -> lift(print a) >> put (10:a)) [1,2,3] [1,2,3] ((),[10,1,2,3]) Prelude ...> runStateT ((get :: StateT [Int] IO [Int]) >>= \a -> liftIO(print a) >> put (10:a)) [1,2,3] [1,2,3] ((),[10,1,2,3]) Prelude ...> runStateT ((return 1 :: StateT Int Maybe Int) `mplus` (return 2)) 0 Just (1,0) Prelude ...> runStateT ((mzero :: StateT Int Maybe Int) `mplus` (return 2)) 0 Just (2,0) Prelude ...> runStateT ((mzero :: StateT Int Maybe Int) `mplus` mzero) 0 Nothing Prelude ...> runStateT ((return 1 :: StateT Int [] Int) `mplus` (return 2)) 0 [(1,0),(2,0)] Prelude ...> runStateT ((mzero :: StateT Int [] Int) `mplus` (return 2)) 0 [(2,0)] Prelude ...> runStateT ((mzero :: StateT Int [] Int) `mplus` mzero) 0 []
それでは簡単な例題として、StackT を使って簡単なスタックを作ってみましょう。次のリストを見てください。
リスト : StateT を使ったスタック
import Control.Monad.State
type Stack a = [a]
type StateE s a = StateT s Maybe a
pop :: StateE (Stack Int) Int
pop = do (x:xs) <- get
put xs
return x
push :: Int -> StateE (Stack Int) ()
push x = do xs <- get
put (x:xs)
stackTest :: StateE (Stack Int) ()
stackTest = do a <- pop
b <- pop
push (a + b)
スタックを pop するとき、空リストの場合は Nothing を返すようにします。最初に、StateT s Maybe a に別名 StateE s a を付けます。pop のデータ型は StateE (Stack Int) Int になります。次に、get でスタックを取り出して変数 (x : xs) にセットします。put で状態を xs に書き換えて、x を return で Just に包んで返します。スタックが空リストの場合、(x : xs) <- get のパターンマッチングで失敗します。ここで fail が呼び出されて Nothing が返されます。push も簡単で、get でリストを取り出して、put でリストを (x : xs) に更新するだけです。
簡単な実行例を示しましょう。
*Main> runStateT stackTest [1,2,3] Just ((),[3,3]) *Main> runStateT stackTest [] Nothing
正常に動作していますね。