更惯用地从 Haskell 中的深度优先预购列表构建 BST

Question

This submission to Programming Praxis 给出了一个 O(n) 函数，它“撤消”二叉搜索树的前序遍历，将列表转换回树。提供缺失数据声明：

数据树 a = 叶 |分支 {value::a, left::Tree a, right:: Tree a} 推导 (Eq, Show) fromPreOrder :: Ord a => [a] -> 树 a fromPreOrder [] = 叶 fromPreOrder (a:as) =​​ 分支 a l (fromPreOrder bs) 在哪里 (l,bs) = 小于 a as 小于 n [] = (叶,[]) 小于 n 全部@(a:as) | a >= n =（叶子，全部） |否则 = (分支 a l r,cs) 其中 (l,bs) = 小于 a 为 (r,cs) = 小于 n bs

很明显，在每个递归步骤中都会向树中添加一个构造函数，这是其效率的关键。

唯一的“问题”是列表是手动通过计算线程化的，这不是一种非常 Haskelian 的方法，并且很难看出它实际上是在单线程中逐个元素地消耗的方式。

我尝试使用状态单子 (prettified on Codepad) 来纠正这个问题：

导入 Control.Monad.State 数据树 a = 叶 |分支 {root::a, left::Tree a, right::Tree a} 推导 (Eq,Show) peek = 状态 peek' 其中 偷看' [] =（什么都没有，[]） peek' a@(x:_) = (只是 x,a) pop = 状态 pop' 其中 pop' [] = error "试图读到列表末尾" pop' (_:xs) = ((),xs) prebuild'::Ord a => State [a] (树 a) 预构建' = 做 下一个 返回叶子 只是 x -> 做 流行音乐 leftpart 返回叶子 只是 x -> 做 如果 x [a] -> 树 a prebuild = evalState prebuild'

不幸的是，这看起来非常混乱，而且似乎并不容易推理。

一个想法我还没有得到任何地方（部分原因是我对基本概念的理解不够深入，很可能）：我可以在列表上使用左折叠来构建一个continuation 最终生成树？那可能吗？还有，这算不算疯狂？

另一个想法是把它写成一棵展开的树，但我认为不可能有效地做到这一点；列表最终会被遍历太多次，程序将是 O(n^2)。

编辑

从另一个方向来看，我有一种挥之不去的怀疑，即有可能提出一种算法，该算法首先将列表分成递增段和递减段，但我还没有找到具体的事情要做有了这个想法。

Answer 1

我认为您在使用 State 时遇到的问题是您的原语（push、pop、peek）不是正确的原语。我认为更好的方法是available_，它检查堆栈的前端是否匹配特定条件，并在每种情况下执行不同的操作：

available_ p f m = do
    s <- get
    case s of
        x:xs | p x -> put xs >> f x
        _ -> m

实际上，在我们的用例中，我们可以稍微专门化一下：当我们的堆栈头部不满足条件时，我们总是希望返回一个Leaf，并且我们总是希望在它满足时递归.

available p m = available_ p
    (\x -> liftM2 (Branch x) (lessThan' x) m)
    (return Leaf)

（您也可以只写available 开头并完全跳过available_。在我的第一次迭代中，这就是我所做的。）现在写fromPreOrder 和lessThan 很容易，而且我想想对他们的行为有一些了解。我将用素数命名它们，以便我们可以使用 QuickCheck 仔细检查它们是否正确。

fromPreOrder' = available (const True) fromPreOrder'
lessThan' n   = available (<n)         (lessThan' n)

在 ghci 中：

> quickCheck (\xs -> fromPreOrder (xs :: [Int]) == evalState fromPreOrder' xs)
+++ OK, passed 100 tests.

Answer 2

虽然我无法回答关于延续传递的问题，但我相信基于 State monad 的实现可以写得更清楚。首先，我们可以使用Control.Applicative 中的符号方便，使其更易于阅读。其次，我们可以升级效果堆栈以包含Maybe，以便（a）从空列表的头部和（b）从(a >= n)比较中捕获失败的概念。

import Control.Monad.State
import Control.Applicative

最终代码使用回溯状态单子转换器堆栈。这意味着我们将State 包裹在Maybe 周围，而不是Maybe 围绕State。在某种意义上，我们可以认为这意味着失败是“主要”效应。在实践中，这意味着如果算法失败，则无法继续使用潜在的不良状态，因此它必须回溯到最后一个已知的良好状态。

type Preord a b = StateT [a] Maybe b    

由于我们一直在获取列表的头部并希望正确捕获该故障，因此我们将使用“安全头部”函数（无论如何它是列表的自然析构函数，尽管不在基本的 Haskell 库中）

-- Safe list destructor
uncons :: [a] -> Maybe (a, [a])
uncons []     = Nothing
uncons (a:as) = Just (a, as)

如果我们仔细观察它，我们会发现这已经是完全我们单子计算的形式（StateT [a] Maybe b 与[a] -> Maybe (b, [a]) 同构）。当提升到Monad 时，我们会给它一个更令人回味的名字。

-- Try to get the head or fail
getHead :: Preord a a
getHead = StateT uncons

该算法的一个共同特点是通过提供默认值来停止本地故障。我将在 certain 组合器中捕获它

-- Provides a default value for a failing computation     
certain :: b -> Preord a b -> Preord a b
certain def p = p <|> return def

现在我们可以在Preord monad 中非常干净地编写最终算法。

fromPreOrder :: Ord a => Preord a (Tree a)
fromPreOrder = certain Leaf $ do
  a <- getHead
  Branch a <$> lessThan a <*> fromPreOrder

lessThan :: Ord a => a -> Preord a (Tree a)
lessThan n = certain Leaf $ do
  a <- getHead
  guard (a < n)
  Branch a <$> lessThan a <*> lessThan n

请注意，Applicative 样式有助于表明我们正在使用进一步有效（状态消耗）计算来构建 Branch 构造函数的组件。当枢轴已经是前序遍历中的最小元素时，guard 短路 lessThan。我们还明确地看到fromPreOrder 和lessThan 在无法计算出更好的结果时默认为Leaf。

（另请注意，fromPreOrder 和 lessThan 现在几乎相同，Daniel Wagner 在编写available 时在他自己的答案中利用了一个共性。）

我们最终想要隐藏所有单子噪声，因为对于外部用户来说，这只是一个纯粹的算法。

rebuildTree :: [a] -> Tree a
rebuildTree = fromMaybe Leaf . runStateT fromPreOrder

---

为了获得完整的图片，这里是仅使用 State monad 的算法实现。注意处理失败的所有额外噪音！我们已经将整个popElse 函数吸收到回溯状态单子的效果中。我们还将if 提升为失败效果。如果没有该效果堆栈，我们的组合器将非常特定于应用程序，而不是解构并在其他地方有用。

-- Try to take the head of the state list and return the default
-- if that's not possible.
popElse :: b -> (a -> State [a] b) -> State [a] b
popElse def go = do
  x <- get
  case x of
    []     -> return def
    (a:as) -> put as >> go a

push :: a -> State [a] ()
push a = modify (a:)

fromPreOrder :: Ord a => State [a] (Tree a)
fromPreOrder = popElse Leaf $ \a -> Branch a <$> lessThan a <*> fromPreOrder

lessThan :: Ord a => a -> State [a] (Tree a)
lessThan n = 
  popElse Leaf $ \a ->
    if a >= n
    then push a >> return Leaf
    else Branch a <$> lessThan a <*> lessThan n

Answer 3

正如你所说，state monad 并没有真正改善这种情况，我认为它不能被期望，因为它太笼统了，因为它允许任意访问 state，而且很烦人因为它强制执行不必要的排序。

乍一看，这看起来很像 foldr ：我们为空的情况做一件事，而在 (:) 的情况下，我们取下头部并基于尾部进行递归调用。然而，由于递归调用不只是直接使用尾部，它并不完全是foldr。

我们可以将其表示为paramorphism，但我认为这并不能真正增加可读性。

我注意到的是尾部复杂的递归都是基于lessThan，这让我想到了以下分解算法的想法：

lessThans [] = []
lessThans (a:as) = (a, l) : lessThans bs
   where (l, bs) = lessThan a as

fromPreOrder2 :: Ord a => [a] -> Tree a
fromPreOrder2 = foldr (\(a, l) r -> Branch a l r) Leaf . lessThans

我确定lessThans 可以有一个更好的名字，但我不太确定是什么！

foldr 也可以表示为foldr (uncurry Branch) Leaf，但我不确定这是否是一种改进。

编辑：另外，lessThans 是 unfoldr，导致这个版本：

fromPreOrder3 :: Ord a => [a] -> Tree a
fromPreOrder3 = foldr (uncurry Branch) Leaf . unfoldr lessThanList

lessThanList [] = Nothing
lessThanList (a:as) = Just ((a, l), bs)
    where (l, bs) = lessThan a as