如何在功能上生成广度优先的树。 （与哈斯克尔）

Question

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

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

我还有一个函数“expand :: Tree a -> Tree a”，它接受一个叶节点， 并将其扩展为一个分支，或者获取一个分支并将其原样返回。该树类型表示 N 元搜索树。

深度优先搜索是一种浪费，因为搜索空间显然是无限的，因为我可以通过对所有树的叶节点使用扩展来轻松地继续扩展搜索空间，并且有可能意外错过目标状态是巨大的...因此唯一的解决方案是广度优先搜索，在 此处，如果存在解决方案，它将找到解决方案。

不过，我想要生成的是遍历树直到找到解决方案。 这是一个问题，因为我只知道如何执行深度优先，这可以通过简单地在第一个子节点上一次又一次地调用“扩展”函数来完成......直到找到目标状态。 （除了一个非常不舒服的列表之外，这实际上不会生成任何东西。）

任何人都可以给我任何关于如何做到这一点（或整个算法）的提示，或者判断它是否可能具有相当的复杂性？ （或者任何有关这方面的资料，因为我发现的很少。）

Answer 1

你看过克里斯·冈崎的“Breadth-第一次编号：算法设计小练习的经验教训”？ 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 促使我摆脱旧的控制结构习惯。我希望这个版本更容易被接受.)

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 序列。