Jak ozdobić drzewo w Haskell

Question

Chcę oznaczyć każdy element drzewa o innej wartości (Int, na przykład sake). Udało mi się to zrobić, ale kod jest brzydki jak bestia i nie wiem jeszcze, jak pracować z Monadami.

My się:

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) 

Znasz jakiś lepszy sposób?

EDYCJA: Właśnie sobie sprawę, że powyższe foldl naprawdę jest mapAccumL. Więc tutaj jest czyszczony wersja powyższego:

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

mam swoje typy nieznacznie zmodyfikowane. Studiować ten kod dokładnie:

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: samo rozwiązanie jak wyżej, ale poddane jednej rundzie refactoring do wielokrotnego użytku części:

-- 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) 

Można dokonać mapTreeM proces wartość lokalny przed poddresami, jeśli chcesz:

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

i korzystania Control.Monad można przekształcić w jedną wkładką:

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

Wykorzystując Data.Traversable i kilka przydatnych rozszerzeń GHC, możemy byłaby sacundim's solution dalej:

{-# 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)