为什么我的MaybeT(State <type>)()忽略状态变化?

时间:2017-07-06 18:32:22

标签: haskell monad-transformers state-monad

简短版本:当我在类型为runMaybeT的monad上使用runState然后MaybeT (State <type>) ()时,即使Maybe看起来状态也不会发生变化{1}}结果等于Just ()。为什么呢?

完整版:我正在编写一个程序来解决河内之塔。我将解决方案表示为State monad列表,在排序时,操作初始Towers状态:

data Towers = Towers [Int] [Int] [Int]
    deriving (Show)
type Move = State Towers ()

towerMoves :: Int -> Rod -> Rod -> [Move]
towerMoves 1 r1 r2 = [pop r1 >>= push r2]
towerMoves n r1 r2 = topToTemp ++ (towerMoves 1 r1 r2) ++ topToFinal
  where
    r3 = other r1 r2
    topToTemp = towerMoves (n - 1) r1 r3
    topToFinal = towerMoves (n - 1) r3 r2

moves = towerMoves 5 First Third
initTowers = Towers [1,2,3,4,5] [] []

main = print $ snd $ runState (sequence_ moves) initTowers

到目前为止,该程序产生了正确的输出:

Towers [] [] [1,2,3,4,5]

然后,我想验证程序是否遵守了拼图的规则,即没有更大的光盘(这里用数字表示)在较小的光盘之前。我想在每Move之后插入某种验证,所以我尝试使用MaybeT monad变换器在移动列表中发送失败:

verifiedMoves :: [MaybeT (State Towers) ()]
verifiedMoves = map ((>> verify) . return) moves
  where
    check :: [Int] -> Bool
    check [] = True
    check [_] = True
    check (x:y:ys) = (x < y) && check (y:ys)
    verify :: MaybeT (State Towers) ()
    verify = do
        (Towers xs ys zs) <- lift get
        guard (check xs && check ys && check zs)

因此我改变了main monad:

main = maybe (putStrLn "violation") (const $ print finalTowers) v
  where
    (v, finalTowers) = runState (runMaybeT $ sequence_ verifiedMoves) initTowers

现在输出看起来不对,就像没有发生状态变化一样:

Towers [1,2,3,4,5] [] []

如果我使初始状态无效,它确实无法通过验证。因此,如果由于Move s的影响被中断而没有状态改变,我希望输出为“违规”。

为什么,在应用runMaybeT之后,是runState等于(Just (), Towers [1,2,3,4,5] [] [])的结果?

以下是其余代码,供参考。我尝试了lifting the get and put monads in my pop and push functions,但产生了相同的输出。

import Control.Monad
import Data.Functor.Identity
import Control.Monad.State
import Control.Monad.Trans.Maybe
import qualified Data.Map as M

data Rod = First | Second | Third
    deriving (Show)

other :: Rod -> Rod -> Rod
other First Second = Third
other Second First = Third
other First Third = Second
other Third First = Second
other Second Third = First
other Third Second = First

getRod :: Towers -> Rod -> [Int]
getRod (Towers x y z) First  = x
getRod (Towers x y z) Second = y
getRod (Towers x y z) Third  = z

setRod :: Rod -> Towers -> [Int] -> Towers
setRod First t ds  = Towers ds r2 r3
  where
    r2 = t `getRod` Second
    r3 = t `getRod` Third
setRod Second t ds = Towers r1 ds r3
  where
    r1 = t `getRod` First
    r3 = t `getRod` Third
setRod Third t ds  = Towers r1 r2 ds 
  where
    r1 = t `getRod` First
    r2 = t `getRod` Second

pop :: Rod -> State Towers Int
pop r = do
    t <- get
    let ds = t `getRod` r
        d = head ds
        load = setRod r
    put $ t `load` (tail ds)
    return d

push :: Rod -> Int -> State Towers ()
push r d = do
    t <- get
    let ds = t `getRod` r
        load = setRod r
    put $ t `load` (d:ds)

1 个答案:

答案 0 :(得分:9)

看看这一行

verifiedMoves = map ((>> verify) . return) moves

相当于

= map (\m -> return m >> verify) moves

但是对于所有x,我们有return x >> a = a,因此

= map (\_ -> verify) moves

所以你放弃了这些动作。您可能打算在那里使用lift而不是return