haskell - 使用 State Monad 插入树

Question

我有一个树和插入操作定义为“为您学习 Haskell 大有裨益!” :

data Tree a = EmptyTree | Node a (Tree a) (Tree a) deriving (Show, Read, Eq) 

treeInsert :: (Ord a) => a -> Tree a -> Tree a  
treeInsert x EmptyTree = Node x EmptyTree EmptyTree
treeInsert x (Node a left right)   
    | x == a = Node x left right  
    | x < a  = Node a (treeInsert x left) right  
    | x > a  = Node a left (treeInsert x right)   

我想使用 State Monad 重新实现 treeInsert，但我什至不确定函数声明应该是什么样子。到目前为止我有这个:

treeInsert :: (Ord a) => a -> Tree a -> State (Tree a) a

如何使用 State Monad 编写 treeInsert？

Answer 1

警告:此回答包含剧透。

您可以相当轻松地围绕现有的 treeInsert 函数编写一个包装器，以允许您按照自己的方式使用 do-notation。根据评论，有一个函数 modify 接受修改函数 f::s -> s 并将其转换为 State s () 这是修改状态 s 的“操作”。这意味着你可以写:

stateTreeInsert :: (Ord a) => a -> State (Tree a) ()
stateTreeInsert x = modify (treeInsert x)

或更简洁:

stateTreeInsert :: (Ord a) => a -> State (Tree a) ()
stateTreeInsert = modify . treeInsert

然后，您可以定义一个“ Action ”，例如:

insertSomeStuff :: (Ord a, Num a) => State (Tree a) ()
insertSomeStuff = do
  stateTreeInsert 0
  stateTreeInsert 1
  stateTreeInsert 2

然后使用 execState 将其应用于特定的树:

main = print $ execState insertSomeStuff EmptyTree

但是，我猜您更感兴趣的是从头开始以状态操纵形式重新实现 treeInsert。

问题是“直截了当”的做法不是很有趣或很符合习惯。这很尴尬。它看起来像这样:

awkwardTreeInsert :: (Ord a) => a -> State (Tree a) ()
awkwardTreeInsert x = do
  t <- get
  case t of
    EmptyTree -> put $ Node x EmptyTree EmptyTree
    Node a l r -> case compare x a of
      LT -> do put l                 -- replace tree with left child
               awkwardTreeInsert x   -- insert into left child
               l' <- get             -- get the answer
               put $ Node a l' r     -- overwrite with whole tree w/ updated left child
      GT -> do put r
               awkwardTreeInsert x
               r' <- get
               put $ Node a l r'
      EQ -> return ()

这里的问题是，正如我们所写的那样，状态一次只能容纳一棵树。所以，如果我们想递归地调用算法在一个分支中插入一些东西，我们需要用它的一个 child 覆盖“大树”，运行递归插入，得到答案，然后用“大树”覆盖它用适当的 child 替换。

无论如何，它的工作方式与 stateTreeInsert 相同，因此:

insertSomeStuff :: (Ord a, Num a) => State (Tree a) ()
insertSomeStuff = do
  awkwardTreeInsert 0
  awkwardTreeInsert 1
  awkwardTreeInsert 2

main = print $ execState insertSomeStuff EmptyTree