我写的是一个真正的monad？

Question

我一直在努力了解monad,因为我最近了解拉链是什么,我认为我可能会尝试将两种想法结合起来.(>> =)做我认为monad应该做的事情,即它让我以拉链的形式组合运动,moveRight >>= moveLeft >>= goAhead >>= return但我觉得我错过了一些东西,因为,除其他外,我似乎不适合它的类型一个单子应该是什么,即Ma -> (a -> Mb) -> Mb.欢迎任何帮助.

module MonadZipper where

import Prelude hiding (return, (>>=))

data Node a = Fork a (Node a) (Node a)
            | Passage a (Node a)
            | DeadEnd a
              deriving (Show)

data Branch a = TurnLeft a (Node a)
              | TurnRight a (Node a)
              | StraightAhead a
                deriving (Show)

type Trace a = [Branch a]
type Zipper a = (Trace a, Node a)


type Movement a = Zipper a -> Maybe (Zipper a)
--not sure whether this wrapping makes sense

turnLeft :: Zipper a -> Maybe (Zipper a)
turnLeft (t, (Fork v l r)) = Just (TurnLeft v r:t, l)
turnLeft _                 = Nothing

turnRight :: Zipper a -> Maybe (Zipper a)
turnRight (t, (Fork v l r)) = Just (TurnRight v l:t, r)
turnRight _                 = Nothing

goAhead :: Zipper a -> Maybe (Zipper a)
goAhead (t, Passage v a) = Just (StraightAhead v:t, a)
goAhead _                = Nothing

(>>=) :: Movement a -> Movement a -> Movement a
(>>=) turner func = \zippo ->
                      case turner zippo of
                        Nothing -> Nothing
                        Just tree -> func tree

return :: Zipper a -> Maybe (Zipper a)
return tree = Just tree

Answer 1

你的Movement类型很像Maybemonad 的组合(允许失败的动作)加上Statemonad和当前Zipper a的状态:

State (Zipper a) b  =  Zipper a -> (b, Zipper a)

我在=这里作弊.这不是State类型的精确定义,但这些类型是同构的,因此您可以将其State视为等于此类型.

换句话说,你已经接近重新发明基于变压器的monad:

type Movement' a b = StateT (Zipper a) Maybe b

主要区别在于Movement' a b同构为:

Zipper a -> Maybe (b, Zipper a)

所以它有b你没有包含的额外价值.

SOOO ....

如果您要将Movement类型重写为:

type Movement a b = Zipper a -> Maybe (b, Zipper a)

你会做点什么的.在这里,Movement不是monad - 相反,Movement a是一个可以应用于底层类型的monad Movement a b.

如果你熟悉Eithermonad,那就是同样的事情: Either它本身不是一个monad,而是Either String一个可以应用于另一种类型的monad,比如Either String Double代表一个返回Double结果或String错误的计算信息.

类似地,你Movement a是一个monad,可以应用于另一种类型Movement a b来表示一个计算,该计算返回一段b时间,保持一个Zipper a内部状态,并通过返回允许失败Nothing.

继续,你的turnLeft,turnRight和goAhead纯粹的效果:他们修改状态(Statemonad 的一部分),如果做出不可能的移动(monad 的一部分),则发出信号错误Maybe,但他们不需要返回任何东西.没关系,因为他们可以回来().这是怎么回事goAhead:

goAhead :: Movement a ()
-- same as:  goAhead :: Zipper a -> Maybe ((), Zipper a)
goAhead (t, Passage v a) = Just ((), (StraightAhead v:t, a))
goAhead _                = Nothing

你可以对turnLeft和做出类似的改动turnRight.

现在,重新定义return相对容易.它应该将一个任意值的类型打包b到你的Movement amonad中而不会产生任何"效果".看看你是否可以填空:

return :: b -> Movement a b
-- same as:  return :: b -> Zipper a -> Maybe (b, Zipper a)
-- in definitino below, right hand side should be:
--     Movement a b = Zipper a -> Maybe (b, Zipper a)
return b = \z -> _

当然,(>>=)有点难.看看你是否能搞清楚:

(>>=) :: Movement a b -> (b -> Movement a c) -> Movement a c
-- in definition below, right-hand side is a:
--   Movement a c = Zipper a -> Maybe (b, Zipper a)
mb >>= bToMc = \z1 -> case mb z1 of ...

如果你放弃,我已经在下面列出了答案.

有了这个monad,事情会变得更有趣.例如,您可以引入确实返回某些内容的操作.这组有效动作怎么样？

data Move = LeftOk | RightOk | StraightOk

validMoves :: Movement a [Move]
validMoves z@(t, n) = case n of
  (Fork _ _ _)  -> Just ([LeftOk, RightOk], z)
  (Passage _ _) -> Just ([StraightOk], z)
  (DeadEnd _)   -> Just ([], z)

或当前位置的元素:

peek :: Movement a a
peek z@(_, n) = case n of
  Fork a _ _  -> Just (a, z)
  Passage a _ -> Just (a, z)
  DeadEnd a   -> Just (a, z)

使用此方法,您可以构建一个遍历拉链的monadic动作,始终使用第一个有效的移动,并返回死角的值:

findDeadEnd :: Movement a a
findDeadEnd =
    validMoves >>= \moves ->
    case moves of [] -> peek
                  (mv:_) -> (case mv of StraightOk -> goAhead
                                        LeftOk     -> turnLeft
                                        RightOk    -> turnRight)
                            >>= \() -> findDeadEnd

如果这是一个真正的monad实例,你可以用do符号更清晰地写上面的内容.

不错,是吗？

无论如何,完整的代码与答案return和>>=以下.接下来,您可能想尝试将您的包装Movement成新类型,以便定义实例:

newtype Movement a b 
  = Movement { runMovement :: Zipper a -> Maybe (b, Zipper a) }
instance Functor (Movement a) where
instance Applicative (Movement a) where
instance Monad (Movement a) where

并看看你是否可以重写所有内容以使其成为现实Monad.

完整的例子:

module MonadZipper where

import Prelude hiding (return, (>>=))

data Node a = Fork a (Node a) (Node a)
            | Passage a (Node a)
            | DeadEnd a
              deriving (Show)

data Branch a = TurnLeft a (Node a)
              | TurnRight a (Node a)
              | StraightAhead a
                deriving (Show)

type Trace a = [Branch a]
type Zipper a = (Trace a, Node a)

type Movement a b = Zipper a -> Maybe (b, Zipper a)

(>>=) :: Movement a b -> (b -> Movement a c) -> Movement a c
mb >>= bToMc = \z1 -> case mb z1 of
                        Nothing -> Nothing
                        Just (b, z2) -> bToMc b z2

return :: b -> Movement a b
return b z = Just (b, z)

turnLeft :: Movement a ()
turnLeft (t, (Fork v l r)) = Just ((), (TurnLeft v r:t, l))
turnLeft _                 = Nothing

turnRight :: Movement a ()
turnRight (t, (Fork v l r)) = Just ((), (TurnRight v l:t, r))
turnRight _                 = Nothing

goAhead :: Movement a ()
goAhead (t, Passage v a) = Just ((), (StraightAhead v:t, a))
goAhead _                = Nothing

data Move = LeftOk | RightOk | StraightOk

validMoves :: Movement a [Move]
validMoves z@(t, n) = case n of
  (Fork _ _ _)  -> Just ([LeftOk, RightOk], z)
  (Passage _ _) -> Just ([StraightOk], z)
  (DeadEnd _)   -> Just ([], z)

peek :: Movement a a
peek z@(_, n) = case n of
  Fork a _ _  -> Just (a, z)
  Passage a _ -> Just (a, z)
  DeadEnd a   -> Just (a, z)

findDeadEnd :: Movement a a
findDeadEnd =
    validMoves >>= \moves ->
    case moves of [] -> peek
                  (mv:_) -> (case mv of StraightOk -> goAhead
                                        LeftOk     -> turnLeft
                                        RightOk    -> turnRight)
                            >>= \() -> findDeadEnd

test = case findDeadEnd ([], (Fork 1 (Fork 2 (Passage 3 (DeadEnd 4))
                                             (DeadEnd 5))
                                     (Passage 6 (DeadEnd 7)))) of
         Just (v, _) -> print v