Personal tools

Zipper monad/TravelTree

From HaskellWiki

(Difference between revisions)
Jump to: navigation, search
m (adding download link)
(removing code, adding entire library download link)
Line 153: Line 153:
== Code ==
== Code ==
-
The <hask>ZipperTree</hask> library ([http://haskell.org/sitewiki/images/8/8b/ZipperTree.hs download]):
+
The code for the TravelTree library is quite length, so you can just [http://haskell.org/sitewiki/images/8/8b/ZipperTree.hs download] it. Alternatively, you could download the [http://haskell.org/sitewiki/images/b/b7/Zipper.tar.gz entire zipper library].
-
 
+
-
<haskell>
+
-
module ZipperTree where
+
-
 
+
-
import Control.Monad.State
+
-
import Control.Arrow (first, second)
+
-
 
+
-
import Zipper
+
-
 
+
-
data Tree a = Leaf a | Branch (Tree a) (Tree a) deriving (Show, Eq)
+
-
 
+
-
data Cxt a = Top
+
-
| L (Cxt a) (Tree a)
+
-
| R (Tree a) (Cxt a)
+
-
deriving (Show)
+
-
 
+
-
type TreeLoc a = Loc (Cxt a) (Tree a)
+
-
type TravelTree a = Travel (TreeLoc a) (Tree a)
+
-
 
+
-
-- Utility Functions
+
-
--
+
-
 
+
-
-- repeat an action until the predicate becomes false
+
-
while :: Monad m => m Bool -> m a -> m [a]
+
-
while p act = do
+
-
b <- p
+
-
if b then liftM2 (:) act (while p act) else return []
+
-
 
+
-
-- Movement around the tree
+
-
--
+
-
 
+
-
-- swap branches
+
-
swap :: TravelTree a
+
-
swap = modify left' >> liftM struct get where
+
-
left' (Loc t (R l c)) = Loc { struct = l,
+
-
cxt = L c t }
+
-
left' (Loc t (L c r)) = Loc { struct = r,
+
-
cxt = R t c }
+
-
 
+
-
-- move down a level, through the left branch
+
-
left :: TravelTree a
+
-
left = modify left' >> liftM struct get where
+
-
left' (Loc (Leaf _ ) _) = error "Down from leaf"
+
-
left' (Loc (Branch l r) c) = Loc { struct = l,
+
-
cxt = L c r }
+
-
 
+
-
-- move down a level, through the left branch
+
-
right :: TravelTree a
+
-
right = modify right' >> liftM struct get where
+
-
right' (Loc (Leaf _ ) _) = error "Down from leaf"
+
-
right' (Loc (Branch l r) c) = Loc { struct = r,
+
-
cxt = R l c }
+
-
 
+
-
-- move to a node's parent
+
-
up :: TravelTree a
+
-
up = modify up' >> liftM struct get where
+
-
up' (Loc _ Top) = error "Up from top"
+
-
up' (Loc t (L c r)) = Loc { struct = Branch t r, cxt = c }
+
-
up' (Loc t (R l c)) = Loc { struct = Branch l t, cxt = c }
+
-
 
+
-
-- move to the top node
+
-
top :: TravelTree a
+
-
top = while (liftM isChild get) up >> liftM struct get
+
-
 
+
-
-- get the Loc corresponding to the top of the tree
+
-
-- useful for when calling traverse.
+
-
-- e.g. (getTop t) `traverse` myPath
+
-
getTop :: Tree a -> TreeLoc a
+
-
getTop t = (Loc t Top)
+
-
 
+
-
-- Node classification
+
-
--
+
-
 
+
-
-- is the top node
+
-
isTop :: TreeLoc a -> Bool
+
-
isTop loc = case loc of
+
-
(Loc _ Top) -> True
+
-
(Loc _ _ ) -> False
+
-
 
+
-
-- is not the top node (i.e. the child of some other node)
+
-
isChild :: TreeLoc a -> Bool
+
-
isChild = not . isTop
+
-
 
+
-
-- is a left branch
+
-
isLeft :: TreeLoc a -> Bool
+
-
isLeft loc = case loc of
+
-
(Loc _ Top ) -> True
+
-
(Loc _ (L _ _)) -> True
+
-
(Loc _ (R _ _)) -> False
+
-
 
+
-
-- is a right branch
+
-
isRight :: TreeLoc a -> Bool
+
-
isRight loc = isTop loc || (not $ isLeft loc)
+
-
</haskell>
+

Revision as of 22:29, 19 April 2006

TravelTree
is a library based on the Zipper monad which is used for traversing binary trees. Read the documentation for the Zipper monad if you haven't already.

Contents

1 Definition 

data Tree a = Leaf a | Branch (Tree a) (Tree a) deriving (Show, Eq)
 
data Cxt a = Top
           | L (Cxt  a) (Tree a)
           | R (Tree a) (Cxt  a)
             deriving (Show)
 
type TreeLoc    a = Loc (Cxt a) (Tree a)
type TravelTree a = Travel (TreeLoc a) (Tree a)
We go with the standard definition of a labelless binary tree.
Cxt
is for storing the context of an element, and
TreeLoc
for precisely defining the position of an element within a tree, at the same time as defining the tree itself. See Zipper for an explanation of that idiom.

2 Functions

2.1 Moving around

There are five 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
swap,  -- moves from a left branch to a right branch, or vice versa
up,    -- moves to the node's parent
top    -- moves to the top node
:: TravelTree a

All five return the subtree at the new location.

2.2 Mutation

The three mutation functions defined by the generic Zipper monad (
modifyStruct
,
getStruct
and
putStruct
) are of course available, but there are no
TravelTree
-specific mutation functions.

2.3 Node classification

There are four functions you can call to find out what kind of node a given location points to: 

isTop,   -- is the location the top node?
isChild, -- is the location the child of some other node (i.e. not the top)?
isLeft,  -- is the location a left branch?
isRight  -- is the location a right branch?
:: TreeLoc a -> Bool
Note that these functions are not monadic but instead take a
TreeLoc
. The
TreeLoc
pointing to the current node is stored as the state in a
TravelTree
computation. Thus to call these functions within a
do
block, use
liftM
: 
do top <- liftM isTop get
   when top $ right >> return ()

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))
The example tree
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> (getTop 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 = (getTop t) `traverse` revTree' where
    revTree' :: TravelTree a
    revTree' = do t <- getTree
                        case t of
                          Branch _ _ -> do left
                                           l' <- revTree'
                                           swap
                                           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 mapper: 

treeMap :: (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
treeMap leaf branch = \t -> (getTop t) `traverse` treeMap' where
    treeMap' = do t <- getTree
                  case t of
                    Branch _ _ -> do left
                                     l' <- treeMap'
                                     swap
                                     r' <- treeMap'
                                     up
                                     putTree $ branch l' r'
                    Leaf x     -> return $ leaf x
revTree
is then easy: 
revTreeZipper :: Tree a -> Tree a
revTreeZipper = treeMap Leaf (flip Branch)
It turns out this is a fairly powerful combinator. As with
revTree
, it can change the structure of a tree. Here's another example which turns a tree into one where siblings are sorted, i.e. given a
Branch l r
, if
l
and
r
are leaves, then the value of
l
is less than or equal to that of
r
. Also, if one of
l
or
r
is a
Branch
and the other a
Leaf
, then
l
is the
Leaf
and
r
the
Branch
: 
sortSiblings :: Ord a => Tree a -> Tree a
sortSiblings = treeMap Leaf minLeaves where
    minLeaves l@(Branch _ _) r@(Leaf _       ) = Branch r l
    minLeaves l@(Leaf _)     r@(Branch _ _   ) = Branch l r
    minLeaves l@(Branch _ _) r@(Branch _ _   ) = Branch l r
    minLeaves l@(Leaf x)     r@(Leaf y       ) = Branch (Leaf $ min x y)
                                                        (Leaf $ max x y)

Result of evaluation: 

*Tree> sortSiblings t
Branch (Branch (Leaf 3) (Branch (Leaf 1) (Leaf 2))) (Branch (Leaf 4) (Leaf 5))

4 Code

The code for the TravelTree library is quite length, so you can just download it. Alternatively, you could download the entire zipper library.

Retrieved from "http://www.haskell.org/haskellwiki/Zipper_monad/TravelTree"