如何在功能上生成寬度優先的樹。 （哈斯克爾）

Question

說我有以下哈斯克爾樹類型，其中「國家」是一個簡單的包裝：

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

我也有一個功能「展開::樹一 - >樹了」，這需要葉節點， 並將其展開爲一個分支，或者採用分支並將其保持不變。該樹類型表示一個N元搜索樹。

搜索深度優先是一種浪費，因爲搜索空間顯然是無限的，因爲我可以通過在所有樹的葉節點上使用擴展來輕鬆地擴展搜索空間，並且意外丟失的機會目標狀態是巨大的......因此唯一的解決方案是寬度優先的搜索，在here上實現得相當不錯，如果它在那裏，它將找到解決方案。

什麼我想要生成，但是，樹是遍歷高達找到解決方案。 這是一個問題，因爲我只知道如何做到這一點，這可以通過在第一個子節點上一次又一次地簡單地調用「擴展」函數來完成......直到找到目標狀態。 （這真的不會產生任何其他事情，然後一個真正不舒服的名單。）

任何人都可以給我任何提示如何做到這一點（或整個算法），或判斷是否有可能與體面的複雜性？ （或者任何有關這方面的資料，因爲我發現很少。）

Answer 1

你看過Chris Okasaki的"Breadth-First Numbering: Lessons from a Small Exercise in Algorithm Design"了嗎？ Data.Tree模塊包含一個名爲unfoldTreeM_BF的monadic樹構建器，該構建器使用從該論文改編而來的算法。

下面是我認爲對應於自己在做什麼的例子：

假設我要搜索所有的留守兒童是父母字符串加「一」串無限二叉樹，右孩子是父母加上「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) 

...當然哪個失敗s在用(== 24)搜索時終止，因爲最左邊的分支是無盡的2系列。