Zipper monad
From HaskellWiki
(Difference between revisions)
(adding examples) |
m (fixing <code>) |
||
| Line 80: | Line 80: | ||
Result of evaluation: | Result of evaluation: | ||
| - | + | *Tree> t `traverse` leftLeftRight | |
| - | *Tree> t `traverse` leftLeftRight | + | Leaf 2 |
| - | Leaf 2 | + | |
| - | + | ||
=== Tree reverser === | === Tree reverser === | ||
| Line 113: | Line 111: | ||
Result of evaluation: | Result of evaluation: | ||
| - | + | *Tree> revTree $ Branch (Leaf 1) (Branch (Branch (Leaf 2) (Leaf 3)) (Leaf 4)) | |
| - | *Tree> revTree $ Branch (Leaf 1) (Branch (Branch (Leaf 2) (Leaf 3)) (Leaf 4)) | + | Branch (Branch (Leaf 4) (Branch (Leaf 3) (Leaf 2))) (Leaf 1) |
| - | Branch (Branch (Leaf 4) (Branch (Leaf 3) (Leaf 2))) (Leaf 1) | + | |
| - | + | ||
==== Generalisation ==== | ==== Generalisation ==== | ||
Revision as of 16:35, 17 April 2006
The TravelTree Monad is a monad proposed and designed by Paolo Martini (xerox), and coded by David House (davidhouse). It is based on the State monad and is used for navigating around in binary trees, using the concept of TheZipper.
Contents |
1 Definition
newtype Travel t a = Travel { unT :: State t a } deriving (Functor, Monad, MonadState t) type TravelTree a = Travel (Loc a) (Tree a)
TravelTree
Loc a
Tree a
data Tree a = Leaf a | Branch (Tree a) (Tree a) data Cxt a = Top | L (Cxt a) (Tree a) | R (Tree a) (Cxt a) deriving (Show) type Loc a = (Tree a, Cxt a)
Cxt
Loc
2 Functions
2.1 Moving around
There are four main functions for stringing togetherTravelTree
left, -- moves down a level, through the left branch right, -- moves down a level, through the right branch up, -- moves to the node's parent top -- moves to the top node :: TravelTree a
All four return the subtree at the new location.
2.2 Mutation
There are also functions available for changing the tree:
getTree :: TravelTree a putTree :: Tree a -> TravelTree a modifyTree :: (Tree a -> Tree a) -> TravelTree a
get
put
modify
2.3 Exit points
To get out of the monad, usetraverse
traverse :: Tree a -> TravelTree a -> Tree a
evalState
(tt, Top)
tt
TravelTree
3 Examples
The following examples use as the example tree:
t = Branch (Branch (Branch (Leaf 1) (Leaf 2)) (Leaf 3)) (Branch (Leaf 4) (Leaf 5))
3.1 A simple path
This is a very simple example showing how to use the movement functions:
leftLeftRight :: TravelTree a leftLeftRight = do left left right
Result of evaluation:
*Tree> t `traverse` leftLeftRight Leaf 2
3.2 Tree reverser
This is a more in-depth example showinggetTree
putTree
The algorithm reverses the tree, in the sense that at every branch, the two subtrees are swapped over.
revTree :: Tree a -> Tree a revTree t = t `traverse` revTree' where revTree' :: TravelTree a revTree' = do t <- getTree case t of Branch _ _ -> do left l' <- revTree' up right r' <- revTree' up putTree $ Branch r' l' Leaf x -> return $ Leaf x -- without using the zipper: revTreeZipless :: Tree a -> Tree a revTreeZipless (Leaf x) = Leaf x revTreeZipless (Branch xs ys) = Branch (revTreeZipless ys) (revTreeZipless xs)
Result of evaluation:
*Tree> revTree $ Branch (Leaf 1) (Branch (Branch (Leaf 2) (Leaf 3)) (Leaf 4)) Branch (Branch (Leaf 4) (Branch (Leaf 3) (Leaf 2))) (Leaf 1)
3.2.1 Generalisation
Einar Karttunen (musasabi) suggested generalising this to a recursive tree combinator:
treeComb :: (a -> Tree a) -- what to put at leaves -> (Tree a -> Tree a -> Tree a) -- what to put at branches -> (Tree a -> Tree a) -- combinator function treeComb leaf branch = \t -> t `traverse` treeComb' where treeComb' = do t <- getTree case t of Branch _ _ -> do left l' <- treeComb' up right r' <- treeComb' up putTree $ branch l' r' Leaf x -> return $ leaf x
revTree
revTreeZipper :: Tree a -> Tree a revTreeZipper = treeComb Leaf (flip Branch)
4 Code
{-# GHC_OPTION -fglasgow-exts #-} data Cxt a = Top | L (Cxt a) (Tree a) | R (Tree a) (Cxt a) deriving (Show) type Loc a = (Tree a, Cxt a) newtype Travel t a = Travel { unT :: State t a } deriving (Functor, Monad, MonadState t) type TravelTree a = Travel (Loc a) (Tree a) left :: TravelTree a left = modify left' >> liftM fst get where left' (Branch l r, c) = (l, L c r) right :: TravelTree a right = modify right' >> liftM fst get where right' (Branch l r, c) = (r, R l c) up :: TravelTree a up = modify up' >> liftM fst get where up' (t, L c r) = (Branch t r, c) up' (t, R l c) = (Branch l t, c) top :: TravelTree a top = modify (second $ const Top) >> liftM fst get modifyTree :: (Tree a -> Tree a) -> TravelTree a modifyTree f = modify (first f) >> liftM fst get putTree :: Tree a -> TravelTree a putTree t = modifyTree $ const t getTree :: TravelTree a getTree = modifyTree id -- works because modifyTree returns the 'new' tree traverse :: Tree a -> TravelTree a -> Tree a traverse t tt = evalState (unT tt) (t, Top)

