para - peta haskell en español

Cómo generar funcionalmente un árbol de amplitud de ancho.(Con Haskell)

Question

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

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

También tengo una función "expand :: Tree a -> Tree a" que toma un nodo 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 profundidad primero es un desperdicio, ya que el espacio de búsqueda es obviamente infinito, ya que puedo seguir expandiendo el espacio de búsqueda con el uso de expandir en todos los nodos de hoja del árbol, y las posibilidades de perder accidentalmente el objetivo-estado es enorme ... por lo tanto, la única solución es una búsqueda amplia, implementada bastante decente aquí , que encontrará la solución si está allí.

Lo que quiero generar, sin embargo, es el árbol recorrido para encontrar la solución. Esto es un problema porque solo sé cómo hacer esto en profundidad, lo que podría hacerse simplemente llamando a la función "expandir" una y otra vez en el primer nodo hijo ... 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 complejidad decente? (O cualquier fuente sobre esto, porque encontré bastante pocos).

Answer 1

¿Has mirado la "Numeración por amplitud-primera de Chris Okasaki : lecciones de un pequeño ejercicio de diseño de algoritmos" ? El módulo Data.Tree incluye un generador de árbol monádico llamado unfoldTreeM_BF que utiliza un algoritmo adaptado de ese documento.

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

Supongamos que quiero buscar en un árbol binario infinito de cadenas donde todos los hijos de la izquierda son la cadena principal más "a", y los secundarios de la derecha son los padres más "bb". Podría usar unfoldTreeM_BF para buscar el árbol de ancho y devolver el árbol buscado a 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 terriblemente bonito, pero funciona. Si busco "aabb" obtengo exactamente lo que quiero:

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

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

ACTUALIZACIÓN: Aquí hay una versión de expand , en caso de que te guste 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 por alejarme de los viejos hábitos de estructura de control. Espero que esta versión sea más aceptable).

Answer 2

Tengo curiosidad por saber por qué necesitas la función expand : ¿por qué no simplemente construir todo el árbol recursivamente y realizar la búsqueda que quieras?

Si usa 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í hay un ejemplo rápido que simplemente devuelve el primer resultado que encuentra, con el falso constructor de Leaf 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

Probándolo en GHCi:

> search (== 24) testTree
24

Por el contrario, aquí hay una búsqueda ingenua de profundidad en primer lugar:

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

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