¿Cómo generar un árbol funcionalmente en amplitud. (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 un nodo hoja, y se expande en una rama, o toma una rama y lo devuelve sin cambios. Este tipo de árbol representa una N-aria de búsqueda de árboles.

La búsqueda primero en profundidad es una pérdida, como la búsqueda del espacio es, obviamente, infinita, como puedo guardar fácilmente en la ampliación de la búsqueda en el espacio con el uso de ampliar en todos los nodos hoja del árbol, y las posibilidades de que accidentalmente falta el meta-estado es enorme ... por lo tanto la única solución es una búsqueda en anchura, implementado sobre bastante decente aquí , que encontrará la solución si está allí.

Lo que quiero para generar, sin embargo, es el árbol atravesado a encontrar la solución. Esto es un problema porque sólo sé cómo hacer esto primero en profundidad, lo que podría hacerse simplemente llamada la función "Expansión" una y otra vez sobre el primer nodo hijo ... hasta que se encuentre una meta-estado. (Esto realmente no generar algo que no sea una lista muy incómodo.)

¿Alguien podría dar alguna pista sobre cómo hacer esto (o la totalidad) de un algoritmo, o un veredicto sobre si es o no es posible con una complejidad decente? (O cualquier fuente sobre esto, porque me pareció bastante pocos.)

Answer 1

¿Usted ha mirado de Chris Okasaki "primero en amplitud Numeración: Lecciones de un pequeño ejercicio en el algoritmo de diseño" ? El módulo Data.Tree incluye un unfoldTreeM_BF llamado constructor árbol monádico que utiliza un algoritmo adaptado de que el 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 los niños son los correctos parental más "BB". Podría usar 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 la insistencia camccann para mí lejos de los viejos hábitos de la estructura de control. Espero que esta versión es más aceptable.)

Answer 2

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

Si está utilizando expand con el fin de realizar un seguimiento de qué nodos son examinados por la búsqueda, creación de una lista a medida que avanza parece, o incluso una segunda estructura de árbol más simple.

Aquí está un ejemplo rápido que sólo devuelve el primer resultado que encuentra, con el constructor Leaf espuria 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 una búsqueda ingenua primero en profundidad:

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

... que por supuesto no finaliza cuando se busca con (== 24), debido a que las ramas más a la izquierda son un sin fin serie de 2s.