Come generare funzionalmente un albero breadth-first. (Con Haskell)
-
27-09-2019 - |
Domanda
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.)
Soluzione
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.)
Altri suggerimenti
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.