# Zipper monad/TravelTree

### From HaskellWiki

TravelTree

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

Cxt

*context*of an element, and

TreeLoc

## 2 Functions

### 2.1 Moving around

There are five main functions for stringing togetherTravelTree

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

putStruct

TravelTree

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

TreeLoc

TreeLoc

TravelTree

do

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

### 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 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 = (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

revTreeZipper :: Tree a -> Tree a revTreeZipper = treeMap Leaf (flip Branch)

revTree

Branch l r

l

r

l

r

l

r

Branch

Leaf

l

Leaf

r

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.