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)
