alpha-1.0: src/My/Data/Tree.hs
module My.Data.Tree(module Data.Tree
,nubT,iterateT
,spanningTree
,branches, nodeList
,descend, descendM) where
import Data.Tree
import qualified Data.Set as S
import Control.Monad.State
nubT t = head $ evalState (nubNode t) S.empty
where nubNode (Node a subs) = gets (S.member a) >>= \b -> if b then return [] else do
modify (S.insert a)
subs <- mapM nubNode subs
return [Node a (concat subs)]
iterateT seed f = unfoldTree (\a -> (a,f a)) seed
branches (Node a []) = [[a]]
branches (Node a (sub:subs)) = let (b:t) = branches sub in ((a:b):t++concatMap branches subs)
spanningTree seed nexts = nubT $ iterateT seed nexts
nodeList n@(Node _ subs) = n:concatMap nodeList subs
descend f s (Node e subs) = Node e' (map (descend f s') subs)
where (e',s') = f e s
descendM f s (Node e subs) = do
(e',s') <- f e s
subs <- mapM (descendM f s') subs
return $ Node e' subs