Comment générer fonctionnellement une largeur d'abord arbre. (Avec Haskell)

Question

Dire que j'ai le type d'arbre Haskell suivant, où "État" est une enveloppe simple:

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

J'ai aussi une fonction "agrandir :: Tree a -> Arbre un" qui prend un nœud feuille, et il se dilate dans une branche, ou prend une branche et la renvoie inchangée. Ce type d'arbre représente une recherche de l'arbre N-aire.

profondeur d'abord est une perte recherche, comme l'espace de recherche est évidemment infinie, que je peux facilement continuer à élargir la recherche de l'espace avec l'utilisation de développer sur tous les nœuds de feuilles de l'arbre, et les chances de manquer accidentellement but Etat est énorme ... donc la seule solution est une recherche en largeur, mis en œuvre assez décent sur ici , qui trouvera la solution si elle est là.

Ce que je veux pour générer, cependant, est l'arbre traversèrent jusqu'à trouver la solution. Ceci est un problème parce que je ne sais comment faire cette profondeur d'abord, ce qui pourrait être fait simplement appelé encore et encore la fonction « expand » sur le premier nœud enfant ... jusqu'à ce que se trouve un objectif d'Etat. (Ce ne serait vraiment pas générer autre chose alors une liste vraiment mal à l'aise.)

Quelqu'un pourrait-il me donner des conseils sur la façon de le faire (ou un algorithme ensemble), ou un verdict sur si oui ou non il est possible avec une complexité décente? (Ou toutes les sources à ce sujet, parce que je trouve assez peu.)

Answer 1

Avez-vous regardé Chris Okasaki « en largeur numérotation: leçons d'un petit exercice dans la conception Algorithm » ? Le module de Data.Tree comprend un constructeur d'arbre monadique nommé unfoldTreeM_BF qui utilise un algorithme adapté à partir de ce document.

Voici un exemple que je pense correspond à ce que vous faites:

Supposons que je veuille la recherche d'un arbre binaire infini de chaînes où tous les enfants gauche sont la chaîne mère plus « un », et les enfants sont les bons parents plus « bb ». Je pourrais utiliser unfoldTreeM_BF pour rechercher la largeur d'abord l'arbre et le retour cherché arbre jusqu'à la solution:

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

Ce n'est pas très jolie, mais cela fonctionne. Si je recherche « AABB » Je reçois exactement ce que je veux:

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

Si c'est le genre de chose que vous décrivez, il ne devrait pas être difficile à adapter à votre type d'arbre.

Mise à jour: Voici une version gratuite de expand do, dans le cas où vous êtes dans ce genre de chose:

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

(Merci à camccann pour moi aiguillonner loin de vieilles habitudes de la structure de contrôle. J'espère que cette version est plus acceptable.)

Answer 2

Je suis curieux de savoir pourquoi vous avez besoin de la fonction expand du tout - pourquoi ne pas simplement construire récursivement l'arbre entier et d'effectuer tout ce que vous voulez effectuez une recherche?

Si vous utilisez expand afin de suivre les noeuds sont examinés par la recherche, la construction d'une liste que vous allez semble plus simple, ou même une seconde structure d'arbre.

Voici un exemple rapide qui renvoie simplement le premier résultat qu'il trouve, avec le constructeur de Leaf parasite supprimé:

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

L'essayer dans GHCi:

> search (== 24) testTree
24

Par contraste, voici une recherche en profondeur d'abord naïve:

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

... qui bien sûr ne parvient pas à mettre fin à la recherche avec (== 24) quand, parce que les plus à gauche branches sont une série sans fin de 2 s.