Cómo generar funcionalmente un árbol de primer orden. (Con Haskell)

Question

Decir que tengo el siguiente tipo de árbol de Haskell, donde "Estado" es un contenedor simple:

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

También tengo una función de "ampliar :: Arbol a -> Tree a", que tiene una nodo de hoja, y lo expande en una rama, o toma una rama y la devuelve inalterada. Este tipo de árbol representa un árbol de búsqueda N-ary.

Buscar primero en profundidad es un desperdicio, ya que el espacio de búsqueda es obviamente infinito, ya que puedo seguir expandiendo el espacio de búsqueda expandiendo en todos los nodos de hoja del árbol y las posibilidades de que falte accidentalmente el objetivo-estado es enorme ... por lo tanto, la única solución es una búsqueda amplia, implementada bastante decente sobre here, que encontrará la solución si está allí.

Lo que yo quiero para generar, sin embargo, es el árbol atravesado hasta encontrar la solución. Esto es un problema porque solo sé cómo hacer esta profundidad primero, lo que podría hacerse simplemente llamando a la función "expandir" una y otra vez en el primer nodo secundario ... hasta que se encuentre un estado de objetivo. (Esto realmente no generaría nada más que una lista realmente incómoda.)

¿Alguien podría darme alguna pista sobre cómo hacer esto (o un algoritmo completo), o un veredicto sobre si es posible o no con una decente complejidad? ? (O cualquier fuente sobre esto, porque encontré bastante pocos.)

Answer 1

¿Has mirado el "Breadth-First Numbering: Lessons from a Small Exercise in Algorithm Design" de Chris Okasaki? El módulo Data.Tree incluye un generador de árbol monádico llamado unfoldTreeM_BF que utiliza un algoritmo adaptado de ese papel.

Aquí hay un ejemplo que creo que corresponde a lo que está haciendo:

Supongamos que quiero buscar un árbol binario infinito de cadenas en el que todos los niños que quedan son la cadena parental más "a", y el derecho los niños son los padres más "bb".Podría utilizar unfoldTreeM_BF a buscar el árbol en amplitud y devolver el árbol buscado hasta la solución:

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 

Esto no es muy bonita, pero funciona. Si busco "aabb" Me da exactamente lo que quiero:

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

Si este es el tipo de cosa que usted está describiendo, no debería ser difícil de adaptar para su tipo de árbol.

ACTUALIZACIÓN: Aquí hay una versión libre-do de expand, en caso de que usted está en este tipo de cosas:.

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 

(Gracias a camccann para pinchar me lejos de los viejos hábitos de la estructura de control espero que este la versión es más aceptable.)

Answer 2

Tengo curiosidad de por qué necesita la función expand en absoluto - ¿por qué no simplemente construir todo el árbol recursivamente y realizar la búsqueda que desee?

Si está utilizando expand para rastrear qué nodos examina la búsqueda, crear una lista sobre la marcha parece más simple, o incluso una segunda estructura de árbol.

Aquí está un ejemplo rápido que sólo devuelve el primer resultado que encuentra, con lo espurio Leaf constructor eliminado:

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 

Ponerlo a prueba en GHCi:

> search (== 24) testTree 
24 

Por el contrario, aquí hay un ingenuo búsqueda profundidad-primer:

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

... que por supuesto fallan s para terminar cuando se busca con (== 24), porque las ramas más a la izquierda son una serie interminable de 2s.