Скажите, что у меня есть следующий тип дерева Haskell, где "состояние" является простой оберткой:
data Tree a = Branch (State a) [Tree a]
| Leaf (State a)
deriving (Eq, Show)
У меня также есть функция, "расширьтесь:: Дерево-> Дерево", который берет вершину и разворачивает ее в ответвление, или берет ответвление и возвращает ее неизменный. Этот древовидный тип представляет дерево поиска Не.
Поиск, в глубину, является отходами, поскольку пространство поиска очевидно бесконечно, поскольку я могу легко продолжить расширяться, пространство поиска с использованием подробно останавливаются на вершинах всего дерева, и возможности случайных пропавших без вести целевого состояния огромны... таким образом, единственным решением является поиск в ширину, реализованный довольно достойный здесь, который найдет решение, если это будет там.
Что я хочу генерировать, тем не менее, дерево, пересеченное до нахождения решения. Это - проблема, потому что я только знаю, как сделать это в глубину, который мог быть сделан просто названным "расширять" функция снова и снова на первый дочерний узел..., пока целевое состояние не найдено. (Это ничего действительно не генерировало бы другой затем действительно неудобный список.)
Кто-либо мог дать мне какие-либо подсказки, как сделать это (или весь алгоритм), или вердикт по тому, возможно ли это с достойной сложностью? (Или любые источники на этом, потому что я нашел совсем немногих.)
Вы смотрели Криса Окасаки «Нумерация в ширину: уроки из небольшого упражнения по разработке алгоритмов» ? Модуль Data.Tree
включает построитель монадического дерева с именем unwoldTreeM_BF
, который использует алгоритм, адаптированный из этой статьи.
Вот пример, который, как мне кажется, соответствует тому, что вы делаете:
Предположим, я хочу выполнить поиск в бесконечном двоичном дереве строк, где все левые дочерние элементы являются родительской строкой плюс «а», а правые дочерние элементы являются родитель плюс "bb". Я мог бы использовать развернутьTreeM_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 за то, что оттолкнули меня от старых привычек структуры управления. Я надеюсь эта версия более приемлема.)
Мне любопытно, зачем вам вообще нужна функция 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
Для контраста, вот наивный метод «сначала глубина» search:
depth (Branch (State x) ts) = x : (concatMap depth ts)
dSearch f t = head $ filter f (depth t)
... который, конечно же, не завершается при поиске с помощью (== 24)
, потому что крайние левые ветви представляют собой бесконечную серию двоек.