Haskell語言學習筆記（25）MonadState, State, StateT

MonadState 類型類

class Monad m => MonadState s m | m -> s where
    get :: m s
    get = state (\s -> (s, s))

    put :: s -> m ()
    put s = state (\_ -> ((), s))

    state :: (s -> (a, s)) -> m a
    state f = do
      s <- get
      let ~(a, s') = f s
      put s'
      return a

modify :: MonadState s m => (s -> s) -> m ()
modify f = state (\s -> ((), f s))

modify' :: MonadState s m => (s -> s) -> m ()
modify' f = state (\s -> let s' = f s in s' `seq` ((), s'))

gets :: MonadState s m => (s -> a) -> m a
gets f = do
    s <- get
    return (f s)

instance Monad m => MonadState s (Lazy.StateT s m) where
    get = Lazy.get
    put = Lazy.put
    state = Lazy.state

instance Monad m => MonadState s (Strict.StateT s m) where
    get = Strict.get
    put = Strict.put
    state = Strict.state

• class Monad m => MonadState s m | m -> s where
  MonadState 是個類型類，它爲 StateT, RWST 等具備 State 功能的 Monad 定義了通用接口。
  所謂 State 功能是指對狀態計算環境的封裝，也就是對函數 \s -> (a, s) 的封裝。
  MonadWriter 包含三個函數：get, put, state。
  get 將結果值設置爲狀態值 s，狀態值 s 保持不變。
  put s 將結果值設爲空，將狀態值設爲 s。
  state f 將函數 f 封裝進 Monad。
  另外同一個模塊中還定義了 modify 和 gets 函數。
  modify f 將結果值設爲空，將狀態值設爲 f s。
  gets f 將結果值設爲 f s，狀態值 s 保持不變。
  What's the 「|」 for in a Haskell class definition?

• instance Monad m => MonadState s (Lazy.StateT s m) where
  get = Lazy.get
  對於 StateT 這個Monad轉換器來講，get等函數的定義均由 StateT 模塊來提供。注意這裏點運算符的含義不是函數的合成而是受限名字。
  Hackage - Where is the MonadReader implementation for ReaderT defined?

StateT Monad轉換器

newtype StateT s m a = StateT { runStateT :: s -> m (a,s) }

instance (Monad m) => Monad (StateT s m) where
    return a = StateT $ \ s -> return (a, s)
    m >>= k  = StateT $ \ s -> do
        ~(a, s') <- runStateT m s
        runStateT (k a) s'

• newtype StateT s m a = StateT { runStateT :: s -> m (a,s) }
  StateT 類型是個 newtype，也就是對現有類型的封裝。該類型有三個類型參數：內部 Monad 類型參數 m，狀態類型參數 s 以及結果類型參數 a。
  StateT s m 類型封裝了一個狀態轉換函數：\s -> m (a,s’)，經過 runStateT 字段能夠從 StateT 類型中取出這個函數。
  該函數接收一個狀態參數 s，通過計算（轉換）以後返回一對封裝在內部 Monad m 中的值：計算結果 a 以及新的狀態 s'。
• instance (Monad m) => Monad (StateT s m) where
  若是 m 是個 Monad，那麼 StateT s m 也是一個 Monad。
  對比 Monad 類型類的定義，可知 return 函數的類型簽名爲：
  return :: a -> StateT s m a
  大體至關於 a -> s -> m (a,s)
  而 bind 函數的類型簽名爲：
  (>>=) :: StateT s m a -> (a -> StateT s m b) -> StateT s m b
  大體至關於 (s -> m (a,s)) -> (a -> s -> m (b,s))) -> (s -> m (b,s))
• return a = StateT $ \s -> return (a, s)
  return 函數將 a 封裝進了狀態轉換函數，該函數首先把結果值設爲 a，狀態值 s 保持不變，而後把這對值封裝進了內部 Monad m。
  這裏左側的 return 是 StateT 這個 Monad 的 return，而右側的 return 是內部 Monad m 的 return。
• m >>= k = StateT $ \s -> do
  對比函數簽名，可知 m 的類型爲 StateT s m a，大體至關於 s -> m (a,s)。
  而 k 的類型爲 a -> StateT s m b，大體至關於 a -> s -> m (b,s)
  bind 操做符組合兩個狀態轉換函數，最終結果仍然是個狀態轉換函數。
• ~(a, s') <- runStateT m s
  這裏首先利用 runState 字段取出 StateT Monad m 中封裝的狀態轉換函數，而後將它應用於狀態值 s 之上，獲得結果值 a 以及新的狀態值 s'。
  runStateT m 讓 m 脫離了 StateT 這個 Monad，而 <- 運算符讓 runStateT m s 脫離了內部 Monad m。
• runStateT (k a) s'
  根據 k 的類型 a -> StateT s m b，可知 k a 的類型爲 StateT s m b，即 k a 也是一個 StateT Monad。
  這裏首先利用 runStateT 字段取出 StateT Monad (k a) 中封裝的狀態轉換函數，而後將它應用於狀態值 s' 之上，獲得一對封裝在內部 Monad m 中的值：最終結果值 a' 和最終狀態值 s''。

證實 StateT s m 符合Monad法則：
1. return a >>= f ≡ f a
return a >>= f
≡ (StateT $ \s -> return (a, s)) >>= f
≡ StateT (\s -> m (a, s)) >>= f
≡ StateT $ \s -> do {~(a, s') <- runStateT (StateT (\s -> m (a, s))) s; runStateT (f a) s'}
≡ StateT $ \s -> do {~(a, s') <- m (a, s); runStateT (f a) s'}
≡ StateT $ \s -> do {~(a, s') <- m (a, s); runStateT (f a) s'}
≡ StateT $ \s -> runStateT (f a) s
≡ StateT $ runStateT (f a)
≡ f a
2. m >>= return ≡ m
m = StateT (\s -> m (a, s))
m >>= return
≡ StateT $ \s -> do {~(a, s') <- runStateT m s; runStateT (return a) s'}
≡ StateT $ \s -> do {~(a, s') <- runStateT (StateT (\s -> m (a, s))) s; runStateT (StateT (\s -> m (a, s))) s'}
≡ StateT $ \s -> do {~(a, s') <- (\s -> m (a, s)) s; (\s -> m (a, s)) s'}
≡ StateT $ \s -> do {~(a, s') <- m (a, s); m (a, s')}
≡ StateT $ \s -> m (a, s)
≡ m
3. (m >>= f) >>= g ≡ m >>= (\x -> f x >>= g)
(m >>= f) >>= g
≡ (StateT $ \s -> do {~(a, s') <- runStateT m s; runStateT (k a) s'}) >> g
≡ StateT $ \s -> do {~(a, s') <- runStateT (StateT $ \s -> do {~(a, s') <- runStateT m s; runStateT (f a) s'}) s; runStateT (g a) s'}
≡ StateT $ \s -> do {~(a, s') <- (\s -> do {~(a, s') <- runStateT m s; runStateT (f a) s'}) s; runStateT (g a) s'}
≡ StateT $ \s -> do {~(a, s') <- do {~(a, s') <- runStateT m s; runStateT (f a) s'}); runStateT (g a) s'}
≡ StateT $ \s -> (runStateT m s >>= \(a, s') -> runStateT (f a) s') >>= \(a, s') -> runStateT (g a) s'
m >>= (\x -> f x >>= g)
≡ StateT $ \s -> do {~(a, s') <- runStateT m s; runStateT ((\x -> f x >>= g) a) s'}
≡ StateT $ \s -> do {~(a, s') <- runStateT m s; runStateT (f a >>= g) s'}
≡ StateT $ \s -> do {~(a, s') <- runStateT m s; runStateT (StateT $ \s -> do {~(a, s') <- runStateT (f a) s; runStateT (g a) s'}) s'}
≡ StateT $ \s -> do {~(a, s') <- runStateT m s; (\s -> do {~(a, s') <- runStateT (f a) s; runStateT (g a) s'}) s'}
≡ StateT $ \s -> do {~(a, s') <- runStateT m s; do {~(a, s') <- runStateT (f a) s'; runStateT (g a) s'}}
≡ StateT $ \s -> runStateT m s >>= \(a, s') -> (runStateT (f a) s' >>= \(a, s') -> runStateT (g a) s')
根據內部 Monad 的法則：(m >>= f) >>= g ≡ m >>= (\x -> f x >>= g)
StateT $ \s -> (runStateT m s >>= \(a, s') -> runStateT (f a) s') >>= \(a, s') -> runStateT (g a) s'
≡ StateT $ \s -> runStateT m s >>= (\(a, s') -> (\(a, s') -> runStateT (f a) s')) (a, s') >>= \(a, s') -> runStateT (g a) s')
≡ StateT $ \s -> runStateT m s >>= \(a, s') -> (runStateT (f a) s' >>= \(a, s') -> runStateT (g a) s')

lift 函數

instance MonadTrans (StateT s) where
    lift m = StateT $ \ s -> do
        a <- m
        return (a, s)

證實 StateT 中 lift 函數的定義符合 lift 的法則。
1. lift . return ≡ return
lift . return $ a
≡ lift (m a)
≡ StateT $ \s -> do {a <- m a; return (a, s)}
≡ StateT $ \s -> m (a, s)
≡ return a
2. lift (m >>= f) ≡ lift m >>= (lift . f)
假設 m = n a 而且 f a = n b
因而 m >>= f = n b
lift (m >>= f)
≡ lift (n b)
≡ StateT $ \s -> do {a <- n b; return (a, s)}
≡ StateT $ \s -> n (b, s)
lift m >>= (lift . f)
≡ (StateT $ \s -> do {a <- n a; return (a, s)}) >>= (\x -> StateT $ \s -> do {a <- f x; return (a, s)})
≡ (StateT $ \s -> n (a s)) >>= (\x -> StateT $ \s -> do {a <- f x; return (a, s)})
≡ StateT $ \s -> do {runStateT (StateT $ \s -> do {a <- f a; return (a, s)}) s}
≡ StateT $ \s -> do {runStateT (StateT $ \s -> do {a <- n b; return (a, s)}) s}
≡ StateT $ \s -> do {runStateT (StateT $ \s -> n (b s)) s}
≡ StateT $ \s -> n (b s)

StateT 是 Functor 也是 Applicative

instance (Functor m) => Functor (StateT s m) where
    fmap f m = StateT $ \ s ->
        fmap (\ ~(a, s') -> (f a, s')) $ runStateT m s

instance (Functor m, Monad m) => Applicative (StateT s m) where
    pure a = StateT $ \ s -> return (a, s)
    StateT mf <*> StateT mx = StateT $ \ s -> do
        ~(f, s') <- mf s
        ~(x, s'') <- mx s'
        return (f x, s'')
    m *> k = m >>= \_ -> k

StateT 是 Alternative 也是 MonadPlus

instance (Functor m, MonadPlus m) => Alternative (StateT s m) where
    empty = StateT $ \ _ -> mzero
    StateT m <|> StateT n = StateT $ \ s -> m s `mplus` n s

instance (MonadPlus m) => MonadPlus (StateT s m) where
    mzero       = StateT $ \ _ -> mzero
    StateT m `mplus` StateT n = StateT $ \ s -> m s `mplus` n s

StateT Monad轉換器的函數

get :: (Monad m) => StateT s m s
get = state $ \ s -> (s, s)

put :: (Monad m) => s -> StateT s m ()
put s = state $ \ _ -> ((), s)

modify :: (Monad m) => (s -> s) -> StateT s m ()
modify f = state $ \ s -> ((), f s)

modify' :: (Monad m) => (s -> s) -> StateT s m ()
modify' f = do
    s <- get
    put $! f s

gets :: (Monad m) => (s -> a) -> StateT s m a
gets f = state $ \ s -> (f s, s)

state :: (Monad m) => (s -> (a, s)) -> StateT s m a
state f = StateT (return . f)

evalStateT :: (Monad m) => StateT s m a -> s -> m a
evalStateT m s = do
    ~(a, _) <- runStateT m s
    return a

execStateT :: (Monad m) => StateT s m a -> s -> m s
execStateT m s = do
    ~(_, s') <- runStateT m s
    return s'

mapStateT :: (m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT f m = StateT $ f . runStateT m

withStateT :: (s -> s) -> StateT s m a -> StateT s m a
withStateT f m = StateT $ runStateT m . f

evalStateT m s 針對 State Monad m 利用初始狀態值 s 進行狀態計算，而後返回最終結果值 a'。
execStateT m s 針對 State Monad m 利用初始狀態值 s 進行狀態計算，而後返回最終狀態值 s'。
mapStateT f m 針對 State Monad m 進行狀態計算以後，對最終結果值和狀態值調用函數 f。
withStateT f m 針對 State Monad m 進行狀態計算以前，對初始狀態值調用函數 f。

Prelude Control.Monad.State> runStateT (return 15) 1
(15,1)
Prelude Control.Monad.State> runStateT get 1
(1,1)
Prelude Control.Monad.State> runStateT (put 3) 1
((),3)
Prelude Control.Monad.State> runStateT (modify (+1)) 1
((),2)
Prelude Control.Monad.State> runStateT (gets (+1)) 1
(2,1)
Prelude Control.Monad.State> evalStateT (gets (+1)) 1
2
Prelude Control.Monad.State> execStateT (gets (+1)) 1
1
Prelude Control.Monad.State> runStateT (do put 3; return 15) 1
(15,3)
Prelude Control.Monad.State> runStateT (put 3 >> return 15) 1
(15,3)

State Monad

type State s = StateT s Identity

runState :: State s a -> s -> (a, s)
runState m = runIdentity . runStateT m

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f = mapStateT (Identity . f . runIdentity)

withState :: (s -> s) -> State s a -> State s a
withState = withStateT

State Monad 是 StateT Monad（轉換器） 的一個特例。

理解 State Monad

假設存在如下的State Monad 的實例 f

f :: State s a

咱們能夠把 f 這個 State Monad 粗略地理解爲一個參數類型爲 s 返回值類型爲 a 的普通函數。

在 f 這個函數之中，「參數」 s 能夠

• 經過調用 modify 或 gets 函數將其隱式地傳給其餘函數。
• 使用 get 函數讀取它的值，使用 put 函數設置它的值，使用 modify 函數修改它的值。
• 經過調用 get 或 gets 函數將其反映爲「返回值」 a。

在 f 這個函數之中，「返回值」 a 能夠

• 經過調用 get 或 gets 函數間接設置它的值。
• 經過調用 return 函數直接設置它的值。
• 經過調用 modify 或 put 函數被清空。

Why must we use state monad instead of passing state directly?

應用實例

import Control.Monad.State

type Stack = [Int]

pop :: State Stack Int  
pop = state $ \(x:xs) -> (x,xs)  

push :: Int -> State Stack ()  
push a = state $ \xs -> ((),a:xs)  

stackManip :: State Stack Int  
stackManip = do  
    push 3  
    a <- pop  
    pop  

stackStuff :: State Stack ()  
stackStuff = do  
    a <- pop  
    if a == 5  
        then push 5  
        else do  
            push 3  
            push 8

moreStack :: State Stack ()  
moreStack = do  
    a <- stackManip  
    if a == 100  
        then stackStuff  
        else return ()

stackyStack :: State Stack ()  
stackyStack = do  
    stackNow <- get  
    if stackNow == [1,2,3]  
        then put [8,3,1]  
        else put [9,2,1]  

main = do
    print $ runState stackManip [5,8,2,1]
    print $ runState stackStuff [9,0,2,1,0]
    print $ runState stackyStack [9,0,2,1,0]
    
{-
(5,[8,2,1])
((),[8,3,0,2,1,0])
((),[9,2,1])
-}