我想用不同的值（例如，Int）标记树的每个元素。我设法做到了，但代码丑得像野兽，我还不知道如何使用 Monads。
我的看法：
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)
你知道更好的方法吗？
编辑： 我刚刚意识到上面的 foldl 真的是 mapAccumL。所以，这里是上面的一个干净的版本：
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)
利用Data.Traversable和一些有用的 GHC 扩展，我们可以进一步重构sacundim 的解决方案：
{-# 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)
我稍微修改了你的类型。仔细研究这段代码：
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'
编辑：与上述相同的解决方案，但将一轮重构为可重用的部分：
-- 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)
如果需要，您可以mapTreeM在子树之前处理本地值：
mapTreeM action (Tree a subtrees) =
do a' <- action a
subtrees' <- mapM (mapTreeM action) subtrees
return $ Tree a' subtrees'
使用Control.Monad你可以把它变成一个单行：
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)