{-
File: alt-linked-tree.hs
Date: 2012/04/14
Author: Michael Schober
Purpose:
A upwards linked tree
-}
-- a binary search tree
data BinTree a = Leaf { parent :: BinTree a }
| Node { value :: a -- payload
, left :: BinTree a -- left subtree
, right :: BinTree a -- right subtree
, parent :: BinTree a -- parent subtree
}
-- prints a simple representation of a tree, excluding the parent node
toSimpleRepresentation :: Show a => BinTree a -> String
toSimpleRepresentation (Leaf _) = "[]"
toSimpleRepresentation (Node v l r _) = "(Node " ++ show v
++ " " ++ toSimpleRepresentation l
++ " " ++ toSimpleRepresentation r ++ ")"
-- like toSimpleRepresentation, but also indicates the parent node
toComplexRepresentation :: Show a => BinTree a -> String
toComplexRepresentation (Leaf _) = "(Leaf ...)"
toComplexRepresentation n@(Node _ _ _ _) = printWithParentMaybe n True
where
printWithParentMaybe :: Show a => BinTree a -> Bool -> String
printWithParentMaybe (Leaf p) _ = "(Leaf " ++ printWithParentMaybe p False ++ ")"
printWithParentMaybe (Node v l r p) True =
"(Node " ++ show v ++
" " ++ (printWithParentMaybe l True) ++ " " ++ (printWithParentMaybe r True) ++
" " ++ (printWithParentMaybe p False) ++ ")"
printWithParentMaybe (Node v _ _ _) False = "(Node " ++ show v ++ " ...)"
instance Show a => Show (BinTree a) where
show = toComplexRepresentation
-- tests whether a tree is empty
null :: BinTree a -> Bool
null (Leaf _) = True
null _ = False
-- returns the number of elements in a search tree
size :: BinTree a -> Int
size (Leaf _) = 0
size (Node _ l r _) = 1 + size l + size r
-- tests whether a value is in a search tree
member :: Ord a => a -> BinTree a -> Bool
member _ (Leaf _) = False
member v' (Node v l r _) =
case compare v' v of
EQ -> True
LT -> member v' l
GT -> member v' r
-- an empty search tree
empty :: BinTree a
empty = (Leaf empty)
-- creates a singleton tree
singleton :: a -> BinTree a
singleton value = let root = Node value (Leaf root) (Leaf root) root
in root
-- searches for an element in a search tree
find :: Ord a => a -> BinTree a -> Maybe (BinTree a)
find _ (Leaf _) = Nothing
find v' n@(Node v l r _) =
case compare v' v of
EQ -> Just n
LT -> find v' l
GT -> find v' r
-- inserts an element into a binary search tree
insert :: Ord a => a -> BinTree a -> BinTree a
insert v' (Leaf parent) =
let result = Node v' (Leaf result) (Leaf result) parent
in result
insert v' n@(Node v l r p) =
case compare v' v of
EQ -> n
LT -> let inserted = insert v' l
result = Node v inserted r p
in result
GT -> let inserted = insert v' r
result = Node v l inserted p
in result
-- an examplary tree for testing purposes
{-
5
/ \
3 8
/ \ / \
1 4 6 10
\ \ /
2 7 9
-}
example :: BinTree Int
example = foldl (flip insert) (singleton 5) [3,4,1,2,8,10,9,6,7]