79 lines
2.1 KiB
Haskell
79 lines
2.1 KiB
Haskell
-- File: BinaryTree.hs
|
|
-- Date: Oct 28, 2011
|
|
-- Author: Collin J. Doering <rekahsoft@gmail.com>
|
|
-- Descpription:
|
|
|
|
module BinaryTree
|
|
(
|
|
Tree,
|
|
search,
|
|
balanced,
|
|
node,
|
|
leaf
|
|
) where
|
|
|
|
-- A Tree reprents a binary tree
|
|
data Tree a = Empty
|
|
| Node a (Tree a) (Tree a)
|
|
deriving (Show, Eq)
|
|
|
|
instance Ord a => Ord (Tree a) where
|
|
_ >= Empty = True
|
|
(Node x _ _) >= (Node y _ _) = x >= y
|
|
|
|
_ <= Empty = True
|
|
(Node x _ _) <= (Node y _ _) = x <= y
|
|
|
|
_ < Empty = False
|
|
(Node x _ _) < (Node y _ _) = x < y
|
|
|
|
_ > Empty = True
|
|
(Node x _ _) > (Node y _ _) = x > y
|
|
|
|
instance Functor Tree where
|
|
fmap _ Empty = Empty
|
|
fmap f (Node x ls rs) = Node (f x) (fmap f ls) (fmap f rs)
|
|
|
|
leaf :: a -> Tree a
|
|
leaf x = Node x Empty Empty
|
|
|
|
-- node a b c = Node a b c where the ording defined by binary trees is enforced
|
|
node :: Ord a => a -> Tree a -> Tree a -> Tree a
|
|
node i Empty Empty = leaf i
|
|
node i nd@(Node x _ _) md@(Node y _ _)
|
|
| x <= i && y >= i = Node i nd md
|
|
| otherwise = Empty
|
|
|
|
balanced :: Ord a => Tree a -> Bool
|
|
balanced Empty = True
|
|
balanced x@(Node _ ls rs) = let y = x >= ls && x <= rs in
|
|
y `seq` (y && balanced ls && balanced rs)
|
|
|
|
-- after further thinking decided not to implement a lookup
|
|
-- function because of how pointless it would be; reasons
|
|
-- being that the lookup would be O(n^2) vs O(n) that
|
|
-- association lists provide. Considered implementing a
|
|
-- searchP :: Ord a => (a -> Bool) -> Tree a -> Maybe a
|
|
-- but again could be only implemented in O(n^2) and is
|
|
-- pretty much the same idea as lookupTree
|
|
--lookupTree :: Ord a => (a -> Bool) -> Tree a -> Maybe a
|
|
|
|
depth :: Tree a -> Int
|
|
depth Empty = 0
|
|
depth (Node _ ls rs) = 1 + max (depth ls) (depth rs)
|
|
|
|
put :: Ord a => a -> Tree a -> Tree a
|
|
put i Empty = leaf i
|
|
put i (Node x ls rs)
|
|
| i > x = Node x ls (put i rs)
|
|
| i < x = Node x (put i ls) rs
|
|
| otherwise = Node x (Node i ls Empty) rs
|
|
|
|
-- Assumes a proper binary tree; thatis balanced node = True
|
|
search :: Ord a => a -> Tree a -> Bool
|
|
search _ Empty = False
|
|
search i (Node x ls rs)
|
|
| i > x = search i rs
|
|
| i < x = search i ls
|
|
| otherwise = True
|