Cómo decorar un árbol en Haskell

Question

Quiero etiquetar cada elemento de un árbol con un valor diferente (Int, por ejemplo, sake). Logré hacer esto, pero el código es feo como una bestia y todavía no sé cómo trabajar con las Mónadas.

Mi opinión:

data Tree a = Tree (a, [Tree a]) 

tag (Tree (x, l)) n = ((m, x), l') 
where (m,l') = foldl g (n,[]) l 
     where g (n,r) x = let ff = tag x n in ((fst $ fst ff) +1, (Tree ff):r) 

¿Conoce alguna manera mejor?

EDIT: Me di cuenta de que el pliegue de arriba es mapAccumL. Por lo tanto, aquí está una versión limpia de lo anterior:

import Data.List (mapAccumL) 

data Tree a = Tree (a, [Tree a]) 

tag (Tree (x, l)) n = ((m,x),l') 
    where (m,l') = mapAccumL g n l 
     g n x = let ff@((f,_),_) = tag x n in (f+1,ff) 

Answer 1

He modificado ligeramente sus tipos. Estudiar el código cuidadosamente:

import Control.Monad.State 

-- It's better not to use a pair as the argument of the constructor  
data Tree a = Tree a [Tree a] deriving Show 

-- We typically want to put the Tree argument last; it makes it 
-- easier to compose tree functions. 
-- 
-- Also, the Enum class is what you want here instead of numbers; 
-- you want a "give me the next tag" operation, which is the succ 
-- method from Enum. (For Int, succ is (+1).) 
tag :: Enum t => t -> Tree a -> Tree (a, t) 
tag init tree = 
    -- tagStep is where the action happens. This just gets the ball 
    -- rolling. 
    evalState (tagStep tree) init 

-- This is one monadic "step" of the calculation. It assumes that 
-- it has access to the current tag value implicitcly. I'll 
-- annotate it in the comments. 
tagStep :: Enum t => Tree a -> State t (Tree (a, t)) 
tagStep (Tree a subtrees) = 
    do -- First, recurse into the subtrees. mapM is a utility function 
     -- for executing a monadic action (like tagStep) on a list of 
     -- elements, and producing the list of results. 
     subtrees' <- mapM tagStep subtrees 

     -- The monadic action "get" accesses the implicit state parameter 
     -- in the State monad. The variable tag gets the value. 
     tag <- get 

     -- The monadic action `put` sets the implicit state parameter in 
     -- the State monad. The next get will see the value of succ tag 
     -- (assuming no other puts in between). 
     -- 
     -- Note that when we did mapM tagStep subtrees above, this will 
     -- have executed a get and a put (succ tag) for each subtree.   
     put (succ tag) 

     return $ Tree (a, tag) subtrees' 

---

EDIT: misma solución que el anterior, pero puesto a través de una ronda de refactorización en piezas reutilizables:

-- This function is not part of the solution, but it will help you 
-- understand mapTreeM below. 
mapTree :: (a -> b) -> Tree a -> Tree b 
mapTree fn (Tree a subtrees) = 
    let subtrees' = map (mapTree fn) subtrees 
     a' = fn a 
    in Tree a' subtrees' 

-- Normally you'd write that function like this: 
mapTree' fn (Tree a subtrees) = Tree (fn a) $ map (mapTree' fn) subtrees 

-- But I wrote it out the long way to bring out the similarity to the 
-- following, which extracts the structure of the tagStep definition from 
-- the first solution above.  
mapTreeM :: Monad m => (a -> m b) -> Tree a -> m (Tree b) 
mapTreeM action (Tree a subtrees) = 
    do subtrees' <- mapM (mapTreeM action) subtrees 
     a' <- action a 
     return $ Tree a' subtrees' 

-- That whole business with getting the state and putting the successor 
-- in as the replacement can be abstracted out. This action is like a 
-- post-increment operator.  
postIncrement :: Enum s => State s s 
postIncrement = do val <- get 
        put (succ val) 
        return val 

-- Now tag can be easily written in terms of those. 
tag init tree = evalState (mapTreeM step tree) init 
    where step a = do tag <- postIncrement 
         return (a, tag) 

Puede hacer mapTreeM proceso el valor local antes de los subárboles si lo desea:

mapTreeM action (Tree a subtrees) = 
    do a' <- action a 
     subtrees' <- mapM (mapTreeM action) subtrees 
     return $ Tree a' subtrees' 

Y el uso de Control.Monad se puede convertir esto en una sola línea:

mapTreeM action (Tree a subtrees) = 
    -- Apply the Tree constructor to the results of the two actions 
    liftM2 Tree (action a) (mapM (mapTreeM action) subtrees) 

-- in the children-first order: 
mapTreeM' action (Tree a subtrees) = 
    liftM2 (flip Tree) (mapM (mapTreeM action) subtrees) (action a) 

Answer 2

Aprovechando Data.Traversable y algunas extensiones útiles GHC, podemos refactorizar sacundim's solution más:

{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-} 

import Control.Monad.State 
import Data.Foldable 
import Data.Traversable 

data Tree a = Tree a [Tree a] 
    deriving (Show, Functor, Foldable, Traversable) 

postIncrement :: Enum s => State s s 
postIncrement = do val <- get 
        put (succ val) 
        return val 

-- Works for any Traversable, not just trees! 
tag :: (Enum s, Traversable t) => s -> t a -> t (a, s) 
tag init tree = evalState (traverse step tree) init 
    where step a = do tag <- postIncrement 
         return (a, tag)