我写的是一个真正的monad？

时间：2018-02-09 10:30:27

标签： haskell functional-programming monads

我一直在努力了解monad，因为我最近了解拉链是什么，我认为我可能会尝试将两种想法结合起来。 （＆gt;＆gt; =）执行我认为monad应该做的事情，即它让我以moveRight >>= moveLeft >>= goAhead >>= return的形式组合拉链周围的动作，但我觉得我错过了一些东西，因为除其他外，我可以似乎它的类型与monad应该是一致的，即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

1 个答案:

答案 0 :(得分：6)

您的Movement类型很像Maybe monad（允许失败的移动）加上State monad以及当前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。

如果你熟悉Either作为monad，那就是同样的事情：Either本身并不是monad，但Either String是可以应用于Either String Double等其他类型的monad，用于表示返回Double结果或String错误消息的计算。

同样，您的Movement a是一个monad，可以应用于另一个类型Movement a b来表示返回b的计算，同时将Zipper a保持为内部状态并通过返回Nothing来允许失败。

继续，您的turnLeft，turnRight和goAhead是纯粹的效果：它们会修改状态（monad的State部分），如果是不可能移动（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 a monad中，而不会产生任何＆＃34;效果＆＃34;。看看你是否可以填空：

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
相关问题
最新问题