para - Cómo decorar un árbol en Haskell

ideas de como decorar el arbol de navidad elegante

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 aún no sé cómo trabajar con las Mónadas.

Mi toma:

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)

¿Conoces alguna forma mejor?

EDITAR: Me acabo de dar cuenta de que el pliegue anterior es mapAccumL. Entonces, aquí hay 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 tus tipos. Estudia este 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''

EDITAR: La misma solución que la anterior, pero pasar por 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 que mapTreeM procese 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 usando Control.Monad puedes convertir esto en un juego de 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 de GHC, podemos refactorizar la solución de sacundim aún 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)