Come generare un albero in modo funzionale. (Con Haskell)

Question

Dire che ho il seguente tipo albero di 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 lo espande in un ramo, o prende un ramo e lo restituisce inalterato. Questo tipo di albero rappresenta un albero di ricerca N-ario.

La ricerca della profondità prima è uno spreco, poiché lo spazio di ricerca è ovviamente infinito, poiché posso facilmente continuare ad espandere lo spazio di ricerca con l'uso di espandere su tutti i nodi foglia dell'albero e le possibilità di perdere accidentalmente lo stato-obiettivo è enorme ... quindi l'unica soluzione è una ricerca di ampiezza, implementata in modo piuttosto decente su here, che troverà la soluzione se è lì.

Quello che voglio per generare, però, è l'albero attraversato fino al trovare la soluzione. Questo è un problema perché so solo come fare questo depth-first, che potrebbe essere fatto semplicemente chiamando la funzione "expand" ancora e ancora sul primo nodo figlio ... finché non viene trovato uno stato-obiettivo. (Questo in realtà non genererebbe niente di diverso da una lista davvero scomoda.)

Qualcuno potrebbe darmi qualche suggerimento su come fare questo (o un intero algoritmo), o un verdetto sul fatto se sia possibile o meno con una complessità decente ? (O qualche fonte su questo, perché ho trovato piuttosto pochi.)

Answer 1

Hai guardato Chrisdi Chris Okasaki? Il modulo Data.Tree include un generatore di alberi monadici denominato unfoldTreeM_BF che utilizza un algoritmo adattato da tale documento.

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

Supponiamo che voglio cercare un albero binario infinito di stringhe in cui tutti i bambini di sinistra sono la stringa genitore più "a", e il diritto i bambini sono i genitori più "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 

Questo 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 adattarsi 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 questo la versione è più accettabile.)

Answer 2

Sono curioso di sapere perché è necessaria la funzione expand - perché non semplicemente costruire l'intero albero in modo ricorsivo ed eseguire qualsiasi ricerca tu voglia?

Se si utilizza expand per tenere traccia dei nodi esaminati dalla ricerca, la creazione di un elenco 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 la spuria Leaf costruttore 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 un ingenuo ricerca approfondita:

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

... che naturalmente non riescono s per terminare durante la ricerca con (== 24), perché i rami più a sinistra sono una serie infinita di 2 secondi.