Как функционально сгенерировать дерево в ширину. (С Haskell)

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

Вы смотрели на Криса Окасаки "Нумерация в ширину: уроки из небольшого упражнения по разработке алгоритма" ? Модуль 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 с.