修改单子状态答案

【问题标题】：Modifying monad state修改单子状态
【发布时间】：2016-10-23 10:00:17
【问题描述】：

对于编程练习，我应该采用数据类型的树

data Tree a = Branch (Tree a) a (Tree a) | Leaf
    deriving (Eq, Ord, Show)

并用一个Int标记每个a，越来越多地，深度优先，使用状态单子，并计算单子动作的数量。例如，表达式

let tree = Branch (Branch Leaf "B" Leaf) "A" Leaf
in run (label tree) 42

应该评估为

(Branch (Branch Leaf (42, "B") Leaf) (43, "A") Leaf
, Counts {binds = 10,returns = 5, gets = 4, puts = 2})

状态的类型是：

newtype State' s a = State' { runState' :: (s, Counts) -> (a, s, Counts) }

这是我对label 和run 的实现

label :: MonadState m Int => Tree a -> m (Tree (Int, a))
label Leaf                      = return Leaf
label (Branch left value right) = do
                                  newLeft  <- label left
                                  int <- get
                                  put (int + 1)
                                  newRight <- label right
                                  return (Branch newLeft (int, value) newRight)


run :: State' s a -> s -> (a, Counts)
run s ns = let (a, _, counts) = runState' s (ns, Counts 0 0 0 0) in (a, counts)

但是，当我运行测试用例时，我的结果是

(Branch (Branch Leaf (42,"B") Leaf) (42,"A") Leaf
, Counts {binds = 12, returns = 5, gets = 6, puts = 2})

Int 似乎根本没有更新。这很奇怪，因为作业的每个部分都有单独的测试用例，除此之外的一切都是正确的。无论如何，这里是 get 和 put 实现：

-- get :: State' s s
get = State' (\(s, counts) -> (s, s, counts <> oneGet))

-- put :: s -> State' s ()
put x = State' (\(x, counts) -> ((), x, counts <> onePut))

我在这里真的很茫然。我不知道为什么Ints 根本不受影响。非常感谢任何帮助。

【问题讨论】：

虽然你没有展示instance Monad State'的实现，但我几乎可以保证它不满足单子定律；计算returns 和binds 不符合法律return x >>= f = f x 和m >>= return = m。（这根本与您的问题无关！）

标签： haskell tree state monads

【解决方案1】：

问题出在

put x = State' (\(x, counts) -> ((), x, counts <> onePut))

在这里，您应该将x 置于一个状态，但它在(x, counts) 模式中被遮蔽了。实现它

put x = State' (\(_, counts) -> ((), x, counts <> onePut))

只要你不关心单子定律，你应该没问题，因为你的任务迫使你违反它们：

计算一元动作的数量

其中一个定律是(return x >>= f) ~ f x，但前一个表达式中多了return和(>>=)。

【讨论】：

@D.Ondor 使用-Wall 打开警告会发现x 的双重绑定。许多陷阱同样通过警告检测到，因此通常建议将其打开。

【解决方案2】：

我知道这是一个作业，但我想指出的是，GHC 几乎可以为您编写所有这些代码！神奇的词是deriving Traversable。

{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
data Tree a = Leaf
            | Node (Tree a) a (Tree a)
            deriving (Functor, Foldable, Traversable)

Traversable 类抽象了对结构的每个元素执行操作的概念。 traverse :: (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) 采用一个函数，该函数对元素 a 执行 Applicative 效果并在整个结构 t 上运行它，对效果进行排序以在 Applicative 上下文中生成 t。

所以我们要做的就是说出如何作用于单个元素，

inc :: a -> State Int (Int, a)
inc x = do
    counter <- get
    put (counter + 1)
    return (counter, x)

Traversable 机器将完成在整个树上运行动作的繁重工作。

label :: Tree a -> Tree (Int, a)
label t = evalState (traverse inc t) 0

Node构造函数的布局决定了遍历顺序；在这种情况下，traverse 将执行有序遍历。

【讨论】：