Как функционально сгенерировать дерево в ширину. (С 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-х.