如何在功能上生成树广度优先.(使用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"函数来完成......直到找到目标状态.(这真的不会产生任何其他的东西,然后是一个非常不舒服的列表.)

任何人都可以给我任何关于如何做到这一点(或整个算法)的暗示,或判断它是否可能具有相当复杂性？(或者是这方面的任何消息来源,因为我发现相当少.)

Answer 1

您是否看过Chris Okasaki的"广度优先编号:算法设计中的小练习课程"？该Data.Tree模块包括一个名为monadic树的构建器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个无尽的系列.