如何使用Haskell实现广度优先生成树的功能。

Question

假设我有以下的Haskell树类型，其中“State”是一个简单的包装器:

data Tree a = Branch (State a) [Tree a]
            | Leaf   (State a)
            deriving (Eq, Show)

我还有一个函数"expand :: Tree a -> Tree a"，它接受一个叶节点并将其扩展为一个分支，或者接受一个分支并返回不变。这种树类型表示一个N叉搜索树。

深度优先搜索是浪费的，因为搜索空间显然是无限的，我可以很容易地通过使用expand在所有树的叶节点上不断扩展搜索空间，并且意外错过目标状态的可能性非常大...因此唯一的解决方案是广度优先搜索，在这里实现得相当不错，如果存在解决方案，它将找到解决方案。

但是我想要生成的是在找到解决方案之前遍历的树。 这是一个问题，因为我只知道如何进行深度优先搜索，这可以通过简单地在第一个子节点上反复调用"expand"函数来完成...直到找到一个目标状态。（这实际上只会生成一个非常不舒适的列表。）

是否有人能给我一些提示如何做到这一点（或整个算法），或者对于是否可能具有合理的复杂度给出裁决？（或任何关于此的来源，因为我发现非常少。）

- wen

---

顺便提一下，你可能想在那里使用其他名称而不是 State，因为该名称在标准库中用于 State monad，这可能会让人们感到困惑。 - C. A. McCann

我刚刚意识到，在这里给出的建议基础上，我正在使用状态单子来实现我的算法。 - wen

Answer 1

你看过 Chris Okasaki 的 “Breadth-First Numbering: Lessons from a Small Exercise in Algorithm Design” 吗？Data.Tree 模块包括一个名为 unfoldTreeM_BF 的单子树构建器，它使用了该论文中改编的算法。

以下是一个我认为与你正在做的事情相对应的示例：

假设我想搜索一个无限的二进制字符串树，其中所有左子节点都是父字符串加上 "a"，右子节点都是父字符串加上 "bb"。我可以使用 unfoldTreeM_BF 广度优先搜索该树，并返回搜索到解的树：

import Control.Monad.State
import Data.Tree

children :: String -> [String]
children x = [x ++ "a", x ++ "bb"]

expand query x = do
  found <- get
  if found
    then return (x, [])
    else do
      let (before, after) = break (==query) $ children x
      if null after
        then return (x, before)
        else do
          put True
          return (x, before ++ [head after])

searchBF query = (evalState $ unfoldTreeM_BF (expand query) []) False

printSearchBF = drawTree . searchBF

这不太美观，但它有效。如果我搜索"aabb"，我会得到我想要的结果：

|
+- a
|  |
|  +- aa
|  |  |
|  |  +- aaa
|  |  |
|  |  `- aabb
|  |
|  `- abb
|
`- bb
   |
   +- bba
   |
   `- bbbb

如果您描述的是这种情况，那么为您的树类型进行适应不应该很难。

更新：这是一个无需执行的expand版本，如果您喜欢这种方式的话。

expand q x = liftM ((,) x) $ get >>= expandChildren
  where
    checkChildren (before, [])  = return before
    checkChildren (before, t:_) = put True >> return (before ++ [t])

    expandChildren True  = return []
    expandChildren _     = checkChildren $ break (==q) $ children x

感谢camccann的帮助，让我远离陈旧的控制结构习惯。我希望这个版本更容易接受。

- Travis Brown

---

亲爱的上帝，那段代码，它...我...但是...你对那个可怜的状态单子在做什么？你这个怪物！ - C. A. McCann

是的，它很丑，但这只是我的想法。你会怎么做呢？我承认我是一个初学者，但我看不出在没有 State 的情况下告诉 unfoldTreeM_BF 停止展开子节点的方法。 - Travis Brown

是的，我认为unfoldTreeM_BF的设计基本上就是这样--更确切地说，使用State实际上比使用显式状态参数更难读懂，至少在我看来是这样。我可能会删除一些多余的do语句并稍微调整一下代码结构，但基本算法不会有根本性的改变。 - C. A. McCann

哈哈，这很诡异！昨晚我尝试修改了一下你的代码，但太累没有完成和发布...但是你改进后的版本非常相似于我想要的，特别是 ((,) x) $ get >>=结构。不过有一个小注释：liftM 对于大多数情况来说与更常见的 fmap 或经常更优雅的 <$> 从 Control.Applicative 组合子是相同的。 - C. A. McCann

说到令人毛骨悚然的事情，我一开始实际上使用了<$>，但后来意识到需要注意额外的import。 - Travis Brown

Answer 2

我很好奇你为什么需要使用expand函数 - 为什么不直接递归构建整个树并执行所需的搜索呢？

如果你使用expand来跟踪搜索过程中检查的节点，那么边遍历边构建列表或者使用第二个树结构似乎更简单。

这里有一个快速示例，它只返回找到的第一个结果，并删除了多余的Leaf构造函数：

data State a = State { getState :: a } deriving (Eq, Show)

data Tree a = Branch { 
    state :: State a, 
    children :: [Tree a]
    } deriving (Eq, Show)

breadth ts = map (getState . state) ts ++ breadth (concatMap children ts)
search f t = head $ filter f (breadth [t])

mkTree n = Branch (State n) (map mkTree [n, 2*n .. n*n])

testTree = mkTree 2

在GHCi中尝试：

> search (== 24) testTree
24

相比之下，这是一个简单的深度优先搜索算法：

depth (Branch (State x) ts) = x : (concatMap depth ts)
dSearch f t = head $ filter f (depth t)

当使用(== 24)进行搜索时，左侧分支是无穷无尽的2，导致搜索失败。

- C. A. McCann

---

强调一下：函数式实现广度优先搜索的“诀窍”是迭代树列表，而不是单个树。在这里，为顶层函数"breadth"和"search"添加类型注释可能会很有用。 - MtnViewMark

我理解这个面向层级的解决方案如何用于BF遍历，但Dennetik想要的是在找到解决方案之前检查的树。这似乎与BF编号大致相当，而且据我所知，面向层级的方法不容易扩展到编号，而Okasaki的基于队列的方法则可以。这就是为什么我在我的答案中使用了unfoldTreeM_BF。我有什么遗漏吗？您能详细说明如何使用您的方法恢复检查过的树吗？ - Travis Brown

我一直在使用“expand”函数，因为我已经太长时间使用Java了，忘记了我可以依靠惰性评估处理无限树。谢谢你提醒我 - 这是我认为你的代码所做的吗？（或者我只是太傻了。） - wen

@Travis Brown：不，你说得对——将我简单的遍历扩展以提取检查的树会使它变得复杂，可能需要通过每个调用线程传递状态参数，即State Monad或类似的东西。远离我与Okasaki争论！ - C. A. McCann

@Dennetik：是的，我的代码定义了一个无限惰性树，然后遍历它。只有被访问的节点才会被求值。这是Haskell语言，可以充分利用它的惰性特性！如果你喜欢，可以尝试一下；不过Travis Brown的回答似乎更符合你的需求。 - C. A. McCann