Numéroter toutes les feuilles présentes dans un arbre de gauche à droite dans Haskell

Ce dont vous avez probablement besoin ici, c'est d'une sorte d ' accumulateur : une variable que vous passez à travers les appels récursifs, et chaque fois que vous incrémentez chaque fois que vous "attribuez" l'identifiant suivant.

Nous définissons donc notre fonction en termes de fonction d'assistance go . go renverra un 2-tuple: l'arbre "étiqueté", et le prochain identifiant que nous "expédierons". Ceci sera utilisé plus tard puisque nous définissons un appel récursif:

labelTree :: Tree a -> Tree (a, Int)
labelTree = fst . go 0
    where go (Leaf x) n = (Leaf (x, n), n+1)
          go (Node l r) n0 = (Node ll lr, n2)
              where (ll, n1) = go l n0
                    (lr, n2) = go r n1

Donc go est de type Int -> Tree a -> (Int , Tree (a, Int)) . Dans le cas où nous voyons une Leaf , nous «expédions» cet identifiant, puis nous renvoyons cette feuille, avec n + 1 comme deuxième partie du tuple, comme:

go (Node l r) n0 = (Node ll lr, n2)
    where (ll, n1) = go l n0
          (lr, n2) = go r n1

pour un nœud, nous allons d'abord envoyer les identifiants dans le sous-arbre de gauche, puis prendre le deuxième élément de ce tuple comme un début pour distribuer des éléments vers le sous-arbre de droite, comme:

go (Leaf x) n = (Leaf (x, n), n+1)

On appelle donc d'abord go l n0 pour étiqueter le sous-arbre de gauche, et on obtient un 2-tuple (ll, n1) qui contient ll le sous-arbre de gauche étiqueté, et n1 le nouveau numéro à envoyer plus tard. Nous appelons go r n1 afin d'envoyer les numéros au bon sous-arbre en commençant par n1 . Notre fonction go retourne donc un nouveau Node avec les sous-arbres étiquetés, et le nouveau numéro à envoyer. Ceci est important pour l'appelant de cette fonction.

Donc, dans son intégralité, nous pouvons étiqueter un arbre avec:

labelTree :: Tree a -> Tree (a, Int)
labelTree = fst . go 0
    where go ...

Vous pouvez utiliser la monade State pour garder une trace du nombre à ajouter à un nœud.

labelTree' :: Tree a -> State Int (Tree (a, Int)) 
            ~ Tree a -> Int -> (Tree (a, Int), Int)
go ::         Tree a -> Int -> (Tree (a, Int), Int)

labelTree ' se construit un calcul avec état qui numérotera les feuilles le long d'un parcours dans l'ordre. evalState exécute ensuite le calcul avec un état initial de 0, de sorte que les feuilles sont numérotées à partir de 0.

Le cas récursif ressemble beaucoup à une fonction d'arbre ordinaire. Au lieu d'appliquer simplement Node aux résultats de chaque appel récursif, vous utilisez l'instance Applicative .

Le cas de base numérote chaque Feuille en utilisant l'état actuel et met à jour l'état de la feuille suivante.

(Notez que ceci est très similaire à Réponse de Willem Van Onsem . Étant donné que State sa est effectivement un wrapper autour des fonctions de type s -> (a, s) , le type de labelTree ':: Tree a -> State Int (Tree (a, Int), Int) peut être amené au même type que go:

labelTree :: Tree a -> Tree (a, Int)
labelTree l = evalState (labelTree' l) 0
    where labelTree' :: Tree a -> State Int (Tree (a, Int))
          labelTree' (Node l r) = Node <$> labelTree' l <*> labelTree' r
          labelTree' (Leaf a) = do n <- get
                                   put $ n + 1
                                   return $ Leaf (a, n)

)

J'ai la même idée en tête que chepner: utiliser State. Cependant, vous n'avez pas à écrire vous-même la récursion car il s'agit d'un simple parcours de l'arbre! Au lieu de cela, dérivez Traversable et Pliable pour votre arbre (bonnes idées quand même), puis appuyez-vous sur eux pour faire la récursion pour vous:

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}

import qualified Control.Monad.Trans.State.Strict as S
data Tree a = Leaf a | Node (Tree a) (Tree a)
            deriving (Show, Functor, Foldable, Traversable)

labelTree :: Tree a -> Tree (a, Int)
labelTree t = S.evalState (traverse applyLabel t) 0
  where applyLabel x = do
          n <- S.get
          S.modify' succ
          pure (x, n)

*Main> labelTree (Node (Node (Leaf 'a') (Leaf 'b')) (Leaf 'c'))
Node (Node (Leaf ('a',0)) (Leaf ('b',1))) (Leaf ('c',2))

Une fonctionnalité intéressante de cette implémentation est qu'elle fonctionnera toujours si vous changez la structure de votre arbre (par exemple, pour stocker des données dans les nœuds intérieurs). Il est impossible de faire des erreurs comme changer l'ordre des nœuds, car vous ne travaillez pas du tout à ce niveau: Traversable le gère pour vous.

Voici la version rapide et sale:

{-# language DeriveTraversable #-}

import Data.Traversable (mapAccumL)

data Tree a
  = Leaf a
  | Node (Tree a) (Tree a)
  deriving (Functor, Foldable, Traversable)

labelTree :: Tree a -> Tree (a, Int)
labelTree = snd .
  mapAccumL (\k a -> (k+1, (a, k))) 1

Malheureusement, c'est probablement un peu trop paresseux pour être très efficace en général. J'essaie toujours de trouver comment atteindre le point idéal de la paresse ici.