状态 Monad - HASKELL

Question

type State = Int
newtype ST a = S (State -> (a, State))

data Tree a = Leaf a | Node (Tree a) (Tree a) deriving (Show)

app :: ST a -> State -> (a, State)
app (S st) s = st s

mlabel :: Tree a -> ST (Tree Int)
mlabel (Leaf _) = fresh >>= (\n -> return (Leaf n))
mlabel (Node l r) = mlabel l >>= (\l ->
                    mlabel r >>= (\r ->
                    return (Node l r)))

fresh :: ST Int
fresh = S (\n -> (n , n +1))

嗨，这是我的代码，我想确保我对 mlabel 函数扩展的理解是正确的。而且我没有使用任何额外的进口。

So suppose mlabel gets a input of Leaf 'a'

fresh >>== (\n -> return (Leaf n))
S (\n -> (n, n+1) >>== (\n -> return (Leaf n))
= S (\s -> let (x, s') = app (S (\n -> (n, n+1)) s
               (x, s') = (s, s+1)
               in app ((\n -> return (Leaf n) x) s'
                = app (S (\x -> (Leaf x, x+1)) s'
                = (\x -> (Leaf x, x+1) s'
                = (Leaf s+1, (s+1)+1)

Answer 1

您尚未包含此 monad 的

>>=

和

return

操作的定义，但我假设您有类似的内容：

return x = S (\s -> (x, s))

a >>= f = S $ \s ->
  let (x, s') = app a s
  in app (f x) s'

如果是这样，则说明您的扩展存在问题：

    app ((\n -> return (Leaf n) x) s'
=   app (S (\x -> (Leaf x, x+1)) s'

第一行缺少一个右括号，我认为你跳过了太多步骤并让自己转身。

无论如何，这应该看起来更像这样：

    app ((\n -> return (Leaf n)) x) s'
=   app (return (Leaf x)) s'                -- apply lambda
=   app (S (\s -> (Leaf x, s))) s'          -- definition of `return`
=   (Leaf x, s')                            -- evaluate `app`

现在，当我们代入

x

中的

s'

和

let (x, s') = (s, s+1) in ...

的值时，我们得到：

=   (Leaf s, s+1)

而不是

(Leaf s+1, (s+1)+1)

。

重写整个

let xxx in yyy

语句可能比尝试分别重写

xxx

和

yyy

部分更安全，所以：

    S $ \s -> let (x, s') = app (S (\n -> (n, n+1))) s
              in app ((\n -> return (Leaf n)) x) s'
-- apply lambda
=   S $ \s -> let (x, s') = app (S (\n -> (n, n+1))) s
              in app (return (Leaf x)) s'
-- definition of `return`
=   S $ \s -> let (x, s') = app (S (\n -> (n, n+1))) s
              in app (S (\s -> (Leaf x, s))) s'
-- expand both `app` calls:
=   S $ \s -> let (x, s') = (s, s+1)
              in (Leaf x, s')
-- substitute `let` definitions:
=   S $ \s -> (Leaf s, s+1)