Como gerar funcionalmente uma largura de árvore. (Com Haskell)

Question

Digamos que eu tenho o seguinte tipo de árvore Haskell, onde "estado" é um invólucro simples:

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

Eu também tenho uma função "Expanda :: Tree A -> Tree A", que pega um nó foliar e a expande para um galho ou pega um galho e o devolve inalterado. Esse tipo de árvore representa uma árvore de pesquisa n-yar.

A profundidade de busca primeiro é um desperdício, pois o espaço de busca é obviamente infinito, pois posso continuar expandindo o espaço de busca com o uso de expandir todos os nós da folha da árvore e as chances de perder acidentalmente o estado de gols é enorme ... portanto, a única solução é uma pesquisa de largura, implementada bastante decente sobre aqui, que encontrará a solução se estiver lá.

O que eu querer gerar, porém, é a árvore atravessada até encontrando a solução. Isso é um problema, porque eu só sei como fazer essa profundidade, o que pode ser feito simplesmente chamado de função "expandir" repetidamente no primeiro nó filho ... até que um estado de gol seja encontrado. (Isso realmente não geraria nada além de uma lista realmente desconfortável.)

Alguém poderia me dar alguma dica sobre como fazer isso (ou um algoritmo inteiro) ou um veredicto sobre se é possível ou não com uma complexidade decente? (Ou qualquer fontes sobre isso, porque eu encontrei poucas.)

Answer 1

Você já olhou para Chris Okasaki "Numeração da largura: lições de um pequeno exercício de design de algoritmo"? o Data.Tree Módulo inclui um construtor de árvores Monadic nomeado unfoldTreeM_BF Isso usa um algoritmo adaptado desse artigo.

Aqui está um exemplo que acho que corresponde ao que você está fazendo:

Suponha que eu queira pesquisar uma árvore binária infinita de cordas, onde todas as crianças esquerdas são a corda dos pais mais "A", e as crianças certas são os pais mais "BB". eu poderia usar unfoldTreeM_BF Para pesquisar na largura da árvore e devolver a árvore pesquisada à solução:

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

Isso não é terrivelmente bonito, mas funciona. Se eu procurar por "AABB", recebo exatamente o que quero:

|
+- a
|  |
|  +- aa
|  |  |
|  |  +- aaa
|  |  |
|  |  `- aabb
|  |
|  `- abb
|
`- bb
   |
   +- bba
   |
   `- bbbb

Se esse é o tipo de coisa que você está descrevendo, não deve ser difícil de adaptar ao seu tipo de árvore.

ATUALIZAÇÃO: Aqui está uma versão livre de expand, caso você esteja nesse tipo de coisa:

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

(Obrigado à CAMCCANN por me afastar dos antigos hábitos da estrutura de controle. Espero que esta versão seja mais aceitável.)

Answer 2

Estou curioso por que você precisa do expand Funcionar tudo-por que não construa apenas a árvore inteira e execute a pesquisa que desejar?

Se você está usando expand Para rastrear quais nós são examinados pela pesquisa, a criação de uma lista à medida que você avança parece mais simples, ou mesmo uma segunda estrutura de árvore.

Aqui está um exemplo rápido que apenas retorna o primeiro resultado que encontra, com o espúrio Leaf Construtor removido:

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

Experimentando em ghci:

> search (== 24) testTree
24

Por outro lado, aqui está uma pesquisa ingênua em profundidade:

depth (Branch (State x) ts) = x : (concatMap depth ts)
dSearch f t = head $ filter f (depth t)

... o que, é claro, falha em terminar ao pesquisar com (== 24), porque os ramos mais à esquerda são uma série interminável de 2s.