Splay trees are balanced binary trees that keep the most recently accessed or inserted item at the top. More information can be found at http://en.wikipedia.org/wiki/Splay_tree

We wish to define splay trees in Haskell and then make an observation about a certain coalgebraic behavior.

We begin with an import that will become relevant later and the type definition:

> import Control.Comonad

>

> data SplayTree a = Null | Node (SplayTree a) a (SplayTree a)

> deriving (Eq)

We also want a way of seeing it. We could have just derived Show, but I like this better:

> instance (Show a) => Show (SplayTree a) where

> show (Node Null stuff Null) = "[" ++ (show stuff) ++ "]"

> show (Node left stuff Null) = "(" ++ (show left) ++ "<--[" ++ (show stuff) ++ "])"

> show (Node Null stuff right) = "([" ++ (show stuff) ++ "]-->" ++ (show right) ++ ")"

> show (Node left stuff right) =

> "(" ++ (show left) ++ "<--[" ++ (show stuff) ++ "]-->" ++ (show right) ++ ")"

> show Null = ""

The functionality of a splay tree derives from classic binary tree operations, together with a "splay" function. The splay function takes care of the rebalancing. We begin by defining a textbook binary search tree insert function.

> binsert :: Ord a => a -> SplayTree a -> SplayTree a

> binsert x (Node left stuff right)

> | x <= stuff = Node (insert x left) stuff right

> | x > stuff = Node left stuff (insert x right)

> binsert x Null = Node Null x Null

The actual splay tree insert will follow once we've defined splay:

> insert x t = splay x (binsert x t)

The splay function is a series of rotations that depends upon where the recently used item, below denoted as x, lies in relation to the root. In fact, we are interested in various configurations where x is the child or grandchild of the current node. If it is not, we just recursively go down a level. This function assumes that x is a member of the tree already. The possibilities are in correspondence with the nice pictures in the above wikipedia page.

We might be already balanced:

> splay x (Node left y right) | x == y = (Node left x right)

What if x is the child of the current node ("zig" or "zag")? A simple rotation will do:

> splay x (Node (Node l1 y l2) p right)

> | x == y = Node l1 x (Node l2 p right)

> splay x (Node left p (Node r1 y r2))

> | x == y = Node (Node left p r1) x r2

Or, x is the left child of the left child (zig-zig) or the right child of the right child (zag-zag):

> splay x (Node (Node (Node ll1 y ll2) p lr) g right)

> | x == y = Node ll1 x (Node ll2 p (Node lr g right))

> splay x (Node left g (Node rl p (Node rr1 y rr2)))

> | x == y = Node (Node (Node left g rl) p rr1) x rr2

The other possibilities are a "zigzag" or "zagzig":

> splay x (Node (Node ll p (Node lr1 y lr2)) g right)

> | x == y = Node (Node ll p lr1) x (Node lr2 g right)

> splay x (Node left g (Node (Node rl1 y rl2) p rr))

> | x == y = Node (Node left g rl1) x (Node rl2 p rr)

These cases cover when we do not see x as a child or grandchild:

> splay x Null = Null

> splay x (Node left stuff right)

> | x <= stuff = splay x (Node (splay x left) stuff right)

> | x > stuff = splay x (Node left stuff (splay x right))

And there you have it! Let's give it a try:

*Main> insert 3 (insert 4 (insert 2 (insert 0 Null)))

(([0]<--[2])<--[3]-->[4])

Notice that 3 is on the top since it was last accessed. Neat!

Membership testing is somewhat interesting. We wish to determine if x is in the tree and splay the tree if this is the case. As such, membership will have an interesting type.

We start off with plain binary tree membership:

> bmember :: Ord a => a -> SplayTree a -> Bool

> bmember x Null = False

> bmember x (Node left y right) | x == y = True

> | x < y = bmember x left

> | x > y = bmember x right

And now we do the required splaying if we find x:

> member :: Ord a => a -> SplayTree a -> (Bool, SplayTree a)

> member x t | (x `bmember` t) = (True, splay x t)

> | not (x `bmember` t) = (False, t)

Note the type signature of member. The part SplayTree a -> (Bool, SplayTree a) looks coalgebraic. Let's see if we can more formally clarify that.

Consider the functor $Bool \times -$. Mathematically, we can identify this with $\mathbb{Z}/{2} \times -$, which has two different monad structures corresponding to the addition and multiplication in $\mathbb{Z}/{2}$. In terms of boolean algebra, these are or and and, respectively.

However, there is also a comonadic structure on $Bool \times -$. Let's see if we can define it:

> newtype BoolFunct a = BoolFunct (Bool, a)

>

> instance Functor BoolFunct where

> fmap f (BoolFunct (b, x)) = BoolFunct (b, f x)

Due to reasons that I do not fully understand, Haskell does not let me declare that (Bool,a) is a functor for any type a. This is why I need the silly type constructor 'BoolFunct'.

The comonadic structure is induced by the diagonal:

> instance Comonad BoolFunct where

> extract (BoolFunct (b, x)) = x

> duplicate (BoolFunct (b, x)) = BoolFunct (b, BoolFunct (b, x))

Of course, one should also check the comonadic laws, namely that duplicate is coassociative and that extract is a counit. This is left as an exercise for the reader.

By the way, I'm a bit bothered that these things are called 'laws' in the community. Physics has 'laws'. Mathematics has axioms. We are really just verifying that an object satisfies the axioms. But I digress...

Let's make an observation:

*Main> :type member 3

member 3 :: (Num a, Ord a) => SplayTree a -> (Bool, SplayTree a)

That's interesting. Detecting whether or not the number 3 is a member seems to give a coalgebra SplayTree Integer -> BoolFunct SplayTree Integer. Of course, one should be dutiful and verify that this is indeed a coalgebraic structure. In fact, this is trivial as soon as you write down the commutative diagram. Here is an example demonstrating coassociativity:

*Main> let t = insert 4 (insert 5 (insert 2 (insert 3 Null)))

*Main> ((fmap (member 3)) . (member 3)) t

(True,(True,([2]<--[3]-->([4]-->[5]))))

*Main> (duplicate . (member 3)) t

(True,(True,([2]<--[3]-->([4]-->[5]))))

There you have it! Accessing a splay tree is a coalgraic operation. I'm not sure if this is a useful observation or not, but part of the mission of this blog is to collect interesting comonads and coalgebras in the Haskell world to understand them better.

Addendum: What I've posted above is correct in spirit but not in letter. If I really want to make member a coalgebra over the comonad BoolFunct, then I need to use the type constructor:

> cmember :: Ord a => a -> SplayTree a -> BoolFunct (SplayTree a)

> cmember x t = BoolFunct (member x t)