Personal tools

Zipper monad

From HaskellWiki

(Difference between revisions)
Jump to: navigation, search
m (fix up code/hask mismatches)
(adding examples)
Line 1: Line 1:
 
 
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]].
 
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]].
   
Line 69: Line 68:
   
 
[[Image:Tree.png|frame|right|The example tree]]
 
[[Image:Tree.png|frame|right|The example tree]]
  +
  +
=== A simple path ===
  +
This is a very simple example showing how to use the movement functions:
  +
<haskell>
  +
leftLeftRight :: TravelTree a
  +
leftLeftRight = do left
  +
left
  +
right
  +
</haskell>
  +
  +
Result of evaluation:
  +
  +
<code>
  +
*Tree> t `traverse` leftLeftRight
  +
Leaf 2
  +
</code>
  +
  +
=== Tree reverser ===
  +
This is a more in-depth example showing <hask>getTree</hask> and <hask>putTree</hask>, but is still rather contrived as it's easily done without the zipper (the zipper-less version is shown below).
  +
  +
The algorithm ''reverses'' the tree, in the sense that at every branch, the two subtrees are swapped over.
  +
  +
<haskell>
  +
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)
  +
</haskell>
  +
  +
Result of evaluation:
  +
  +
<code>
  +
*Tree> revTree $ Branch (Leaf 1) (Branch (Branch (Leaf 2) (Leaf 3)) (Leaf 4))
  +
Branch (Branch (Leaf 4) (Branch (Leaf 3) (Leaf 2))) (Leaf 1)
  +
</code>
  +
  +
==== Generalisation ====
  +
Einar Karttunen (musasabi) suggested generalising this to a recursive tree combinator:
  +
  +
<haskell>
  +
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
  +
</haskell>
  +
  +
<hask>revTree</hask> is then easy:
  +
  +
<haskell>
  +
revTreeZipper :: Tree a -> Tree a
  +
revTreeZipper = treeComb Leaf (flip Branch)
  +
</haskell>
   
 
== Code ==
 
== Code ==
   
 
<haskell>
 
<haskell>
  +
{-# GHC_OPTION -fglasgow-exts #-}
 
data Cxt a = Top
 
data Cxt a = Top
 
| L (Cxt a) (Tree a)
 
| L (Cxt a) (Tree a)
Line 83: Line 159:
 
deriving (Functor, Monad, MonadState t)
 
deriving (Functor, Monad, MonadState t)
 
type TravelTree a = Travel (Loc a) (Tree a)
 
type TravelTree a = Travel (Loc a) (Tree a)
 
t = Branch (Branch (Branch (Leaf 1) (Leaf 2))
 
(Leaf 3))
 
(Branch (Leaf 4)
 
(Leaf 5))
 
   
 
left :: TravelTree a
 
left :: TravelTree a
Line 116: Line 187:
 
traverse :: Tree a -> TravelTree a -> Tree a
 
traverse :: Tree a -> TravelTree a -> Tree a
 
traverse t tt = evalState (unT tt) (t, Top)
 
traverse t tt = evalState (unT tt) (t, Top)
 
leftLeftRight :: TravelTree a
 
leftLeftRight = do left
 
left
 
right
 
 
revTreeZipper :: Tree a -> Tree a
 
revTreeZipper t = t `traverse` revTreeZipper' where
 
revTreeZipper' :: TravelTree a
 
revTreeZipper' = do t <- getTree
 
case t of
 
Branch _ _ -> do left
 
l' <- revTreeZipper'
 
up
 
right
 
r' <- revTreeZipper'
 
up
 
putTree $ Branch r' l'
 
Leaf x -> return $ Leaf x
 
 
</haskell>
 
</haskell>

Revision as of 16:33, 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)
Computations in
TravelTree
are stateful.
Loc a
and
Tree a
are defined as follows:
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)
See TheZipper for an explanation of the
Cxt
and
Loc
concepts.

2 Functions

2.1 Moving around

There are four main functions for stringing together
TravelTree
computations:
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
These are direct front-doors for State's
get
,
put
and
modify
, and all three return the subtree after any applicable modifications.

2.3 Exit points

To get out of the monad, use
traverse
:
traverse :: Tree a -> TravelTree a -> Tree a
Again, this is just a front-door for
evalState
, with an initial state of
(tt, Top)
where
tt
is the
TravelTree
passed in.

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))
(thumbnail)
The example tree

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 showing
getTree
and
putTree
, but is still rather contrived as it's easily done without the zipper (the zipper-less version is shown below).

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
is then easy:
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)