Come generare funzionalmente un albero breadth-first. (Con Haskell)

Question

Di 'Ho il seguente tipo di albero Haskell, dove "Stato" è un semplice involucro:

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

Ho anche una funzione di "espandere :: albero a -> albero un" che prende un nodo foglia, e si espande in un ramo, o prende un ramo e restituisce inalterato. Questo tipo albero rappresenta una N-ario di ricerca-albero.

Ricerca in profondità è uno spreco, come la ricerca-spazio è ovviamente infinito, come posso facilmente continuare a espandere la ricerca-spazio con l'utilizzo di espansione su tutti i nodi foglia dell'albero, e le possibilità di perdere accidentalmente il obiettivo-stato è enorme ... quindi l'unica soluzione è una ricerca breadth-first, implementato nel corso abbastanza decente qui , che troverà la soluzione se è lì.

Quello che voglio per generare, però, è l'albero muovere fino a trovare la soluzione. Questo è un problema perché so solo come fare questo in profondità, che potrebbe essere fatto da chiamato semplicemente il "espandere" ancora e ancora la funzione sul primo nodo figlio ... finché non si trova un obiettivo-stato. (Questo in realtà non generare qualcosa di diverso, allora un elenco veramente a disagio.)

Qualcuno mi potrebbe dare alcun suggerimento su come fare questo (o un intero algoritmo), oppure un verdetto sulla necessità o meno è possibile con una complessità decente? (O qualsiasi fonti su questo, perché ho trovato piuttosto pochi.)

Answer 1

Hai guardato di Chris Okasaki "breadth-first Numerazione: lezioni da un piccolo esercizio in Algorithm design" ? Il modulo Data.Tree include una monade Tree Builder nome unfoldTreeM_BF che utilizza un algoritmo adattato da quella carta.

Ecco un esempio che credo corrisponda a quello che stai facendo:

Supponiamo che io voglio cercare un albero binario infinito di stringhe in cui tutti i bambini sono di sinistra la stringa genitore più "a", ed i bambini destra sono il genitore plus "BB". Potrei usare unfoldTreeM_BF per cercare l'albero in ampiezza e restituire l'albero cercato fino alla soluzione:

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

Questa non è molto bella, ma funziona. Se cerco "AABB" ottengo esattamente quello che voglio:

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

Se questo è il genere di cose che stai descrivendo, non dovrebbe essere difficile per adattare per il vostro tipo di albero.

UPDATE: Ecco una versione gratuita-do di expand, nel caso in cui siete in questo genere di cose:

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

(Grazie a camccann per me incitamento lontano da vecchie abitudini di struttura di controllo. Spero che questa versione è più accettabile.)

Answer 2

Sono curioso di sapere perchè avete bisogno della funzione expand a tutti - perché non è sufficiente costruire l'intero albero in modo ricorsivo e eseguire qualsiasi ricerca che si desidera?

Se stai usando expand al fine di monitorare che i nodi vengono esaminati dalla ricerca, costruzione di una lista, come si va sembra più semplice, o anche una seconda struttura ad albero.

Ecco un rapido esempio che restituisce solo il primo risultato che trova, con il costruttore Leaf spuria rimosso:

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

provarlo in GHCi:

> search (== 24) testTree
24

Per contrasto, ecco una ricerca ingenuo in profondità:

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

... che ovviamente non riesce a terminare durante la ricerca con (== 24), perché i più a sinistra rami sono infinite serie di 2s.