Skip to content

Instantly share code, notes, and snippets.



Last active Dec 19, 2018
What would you like to do?
A demonstration of simple binary search trees in Haskell
-- For strictness evaluation, we turn on bang patterns.
{-# LANGUAGE BangPatterns #-}
import Data.List --get some list functions.
--A tree which can hold values of any type. Either a Tip or a node with two children, both of which are also trees.
-- Deriving show is deriving from the show typeclass, which makes the compiler automatically able to print them, all be it not beautifully.
data Tree a = Tip | Node a (Tree a) (Tree a) deriving Show
--Function which works on treees so long as their contents are orderable, and returns a bool indicating if the item is in it.
contains::(Ord a) => a->Tree a->Bool
contains val tr = case tr of --this is pattern matching.
Tip -> False -- If tr is Tip, it's the empty tree.
Node cont left right | cont == val -> True --Match a node, extracting its value to cont but only if cont is what we want.
Node cont left right -> -- Match any node at all.
if val <= cont
then (contains val left)
else (contains val right)
--This function demonstrates the lack of mutability.
--We're conceptually rebuilding the tree.
treeInsert :: (Ord a) => a->Tree a->Tree a
treeInsert val tr = case tr of
Tip -> Node val Tip Tip -- Empty trees are replaced with a node containing val.
--Otherwise, we need to insert it either in the left subtree or the right. Insert returns a new tree, so we replace that subtree in the new tree we're recursively building and return the whole thing.
Node cont left right ->
if val <= cont
then Node cont (treeInsert val left) right
else Node cont left (treeInsert val right)
--This uses fold, which calls a function on every item of a list.
--It's kind of like reduce in some languages: the function gets an accumulator and the current value, and needs to return the new accumulator.
--In this case, we just insert the item into the accumulator, returning the new tree. The initial accumulator is Tip, the empty tree.
listToTree:: (Ord a)=>[a]->Tree a
listToTree l = foldl' (\tr v-> treeInsert v tr) Tip l
--This converts a tree to a list by first converting the right tree, prepending the current item, and then converting the left tree and prepending that as well.
-- Warning: this will not work on large trees. A more advanced version using the . operator (function composition) and an accumulator will.
-- The inefficiency here demonstrates a common idiome in haskell: recursing with an accumulator often works better for non-tail-recursive calls.
treeToList::Tree a->[a]
treeToList tr = case tr of
Tip -> []
Node v l r -> treeToList(l) ++ [v] ++ treeToList(r)
--This demonstrates strict patterns.
--If we write this naively, the length of a tree is 1 plus the length of the left and right subtrees, laziness bites us.
-- In that case, the accumulator stores a huge list of thuncks representing addition, which don't get evaluated until we return.
-- We still store this list of thuncks, but the ! forces evaluation of acc every time the function encounters a Tip.
-- The odd recursion in the last lineis explained as follows:
-- add one to acc and pass it to a call finding the length of the right subtree, and then let that be the accc to a call finding the length of the left subtree.
--Note that we do not constrain the elements to be Ord:treeLength works on any tree.
treeLength::Tree a->Int
treeLength tr = treeLengthHelper tr 0 where
treeLengthHelper::Tree a->Int->Int
treeLengthHelper Tip !acc = acc
treeLengthHelper (Node _ l r) !acc = (treeLengthHelper l (treeLengthHelper r (acc + 1)))
-- This one is as simple as it looks.
-- The minimum value of a bst is found by going left as far as possible.
treeMin::(Ord a)=>Tree a->a
treeMin tr = case tr of
Node val Tip _ -> val
Node _ left _ -> treeMin(left)
-- This is simple enough for the most part, but see below for the comments on the last case.
treeDelete::(Ord a)=>a->Tree a->Tree a
treeDelete val tr = case tr of
Tip -> Tip
Node v l r | val <= v-> Node v (treeDelete val l) r
Node v l r | val > v -> Node v l (treeDelete val r)
Node v Tip Tip | v == val -> Tip
Node v l Tip | v == val -> l
Node v Tip r | v == val -> r
--The standard algorithm for deletion when the node to be deleted has two children is to swap the value with the min of the right subtree and then remove it.
--But we're in a functional language.
--So, instead: find the min of the right subtree, delete it from the right subtree, and then return a new treee that has the min of the right subtree as the root. Delete will eventually recursively hit one of the above cases so long as the tree isn't infinite, so this won't recurse forever (or even very much).
Node v l r | v == val -> Node minv l (treeDelete minv r) where
minv = treeMin r
--This is a set of conditions and directions for comparing trees for equality.
--The condition is that the elements must also be comparable for equality.
--Because of laziness and garbage collection, converting trees to lists and comparing that way is basically as efficient as traversing them directly (disclaimer: I may be wrong about that).
instance (Eq a) => Eq (Tree a) where
t1 == t2 = treeToList(t1) == treeToList(t2)
--This is similar to the above, but for ordering: the comparison to see if a tree is "less than" another tree.
--With this and the previous, we can have trees of trees of trees of... so long as the deepest treees have orderable elements.
instance(Ord a) => Ord (Tree a) where
compare t1 t2
| (treeToList t1) < (treeToList t2) = LT
| (treeToList t1) == (treeToList t2) = EQ
| otherwise = GT
--Note: this does not return a valid bst.
-- But it's good enough for benchmarking treeLength for large values, which is what we want to do below.
-- The old approach was inserting a bunch of random numbers, but this was actually leading to unbalanced trees.
bigTree 0 = Tip
bigTree n = Node n (bigTree (n-1)) (bigTree (n-1))
main = do
print $! treeLength (bigTree 29)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.