Skip to content

GitLab

Commit bc4c4720 authored by Michael Hanus's avatar Michael Hanus
Browse files

red-black tree modules removed (available in package redblacktree)

parent c8d0428b
Hide whitespace changes
Inline Side-by-side
RedBlackTree.curry deleted 100644 → 0
View file @ c8d0428b
---------------------------------------------------------------------------
--- Library with an implementation of red-black trees:
--- <P>
--- Serves as the base for both TableRBT and SetRBT
--- All the operations on trees are generic, i.e., one has to provide
--- two explicit order predicates ("<CODE>lessThan</CODE>" and "<CODE>eq</CODE>"below)
--- on elements.
---
--- @author Johannes Koj, Michael Hanus, Bernd Brassel
--- @version March 2005
--- @category algorithm
----------------------------------------------------------------------------
module RedBlackTree
( RedBlackTree, empty, isEmpty, lookup, update
, tree2list, sortBy, newTreeLike, setInsertEquivalence, delete
) where
----------------------------------------------------------------------------
-- the main interface:
--- A red-black tree consists of a tree structure and three order predicates.
--- These predicates generalize the red black tree. They define
--- 1) equality when inserting into the tree<br>
--- eg for a set eqInsert is (==),
--- for a multiset it is (\ _ _ -> False)
--- for a lookUp-table it is ((==) . fst)
--- 2) equality for looking up values
--- eg for a set eqLookUp is (==),
--- for a multiset it is (==)
--- for a lookUp-table it is ((==) . fst)
--- 3) the (less than) relation for the binary search tree
data RedBlackTree a
= RedBlackTree
(a -> a -> Bool) -- equality for insertion
(a -> a -> Bool) -- equality for lookup
(a -> a -> Bool) -- lessThan for search
(Tree a) -- contents
--- The three relations are inserted into the structure by function empty.
--- Returns an empty tree, i.e., an empty red-black tree
--- augmented with the order predicates.
empty :: (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool)
-> RedBlackTree a
empty eqInsert eqLookUp lessThan = RedBlackTree eqInsert eqLookUp lessThan Empty
--- Test on emptyness
isEmpty :: RedBlackTree _ -> Bool
isEmpty (RedBlackTree _ _ _ Empty) = True
isEmpty (RedBlackTree _ _ _ (Tree _ _ _ _)) = False
--- Creates a new empty red black tree from with the same ordering as a give one.
newTreeLike :: RedBlackTree a -> RedBlackTree a
newTreeLike (RedBlackTree eqIns eqLk lt _) = RedBlackTree eqIns eqLk lt Empty
--- Returns an element if it is contained in a red-black tree.
--- @param p - a pattern for an element to look up in the tree
--- @param t - a red-black tree
--- @return the contained True if p matches in t
lookup :: a -> RedBlackTree a -> Maybe a
lookup p (RedBlackTree _ eqLk lt t) = lookupTree eqLk lt p t
lookupTree :: (a -> a -> Bool) -> (a -> a -> Bool) -> a -> Tree a -> Maybe a
lookupTree _ _ _ Empty = Nothing
lookupTree eq lt p (Tree _ e l r)
| eq p e = Just e
| lt p e = lookupTree eq lt p l
| otherwise = lookupTree eq lt p r
--- Updates/inserts an element into a RedBlackTree.
update :: a -> RedBlackTree a -> RedBlackTree a
update e (RedBlackTree eqIns eqLk lt t) =
RedBlackTree eqIns eqLk lt (updateTree eqIns lt e t)
updateTree :: (a -> a -> Bool) -> (a -> a -> Bool) -> a -> Tree a -> Tree a
updateTree eq lt e t = let (Tree _ e2 l r) = upd t
in Tree Black e2 l r
where
upd Empty = Tree Red e Empty Empty
upd (Tree c e2 l r) | eq e e2 = Tree c e l r
| lt e e2 = balanceL (Tree c e2 (upd l) r)
| otherwise = balanceR (Tree c e2 l (upd r))
--- Deletes entry from red black tree.
delete :: a -> RedBlackTree a -> RedBlackTree a
delete e (RedBlackTree eqIns eqLk lt t) =
RedBlackTree eqIns eqLk lt (blackenRoot (deleteTree eqLk lt e t))
where
blackenRoot Empty = Empty
blackenRoot (Tree _ x l r) = Tree Black x l r
deleteTree :: (a -> a -> Prelude.Bool)
-> (a -> a -> Prelude.Bool) -> a -> Tree a -> Tree a
deleteTree _ _ _ Empty = Empty -- no error for non existence
deleteTree eq lt e (Tree c e2 l r)
| eq e e2 = if isEmptyTree l then addColor c r else
if isEmptyTree r
then addColor c l
else let el = rightMost l
in delBalanceL (Tree c el (deleteTree eq lt el l) r)
| lt e e2 = delBalanceL (Tree c e2 (deleteTree eq lt e l) r)
| otherwise = delBalanceR (Tree c e2 l (deleteTree eq lt e r))
where
addColor DoublyBlack tree = tree -- should not occur
addColor Red tree = tree
addColor Black Empty = Empty
addColor Black (Tree Red x lx rx) = Tree Black x lx rx
addColor Black (Tree Black x lx rx) = Tree DoublyBlack x lx rx
addColor Black (Tree DoublyBlack x lx rx) = Tree DoublyBlack x lx rx
rightMost Empty = error "RedBlackTree.rightMost"
rightMost (Tree _ x _ rx) = if isEmptyTree rx then x else rightMost rx
--- Transforms a red-black tree into an ordered list of its elements.
tree2list :: RedBlackTree a -> [a]
tree2list (RedBlackTree _ _ _ t) = tree2listTree t
tree2listTree :: Tree a -> [a]
tree2listTree tree = t2l tree []
where
t2l Empty es = es
t2l (Tree _ e l r) es = t2l l (e : t2l r es)
--- Generic sort based on insertion into red-black trees.
--- The first argument is the order for the elements.
sortBy :: Eq a => (a -> a -> Bool) -> [a] -> [a]
sortBy cmp xs = tree2list (foldr update (empty (\_ _->False) (==) cmp) xs)
--- For compatibility with old version only
setInsertEquivalence :: (a -> a -> Bool) -> RedBlackTree a -> RedBlackTree a
setInsertEquivalence eqIns (RedBlackTree _ eqLk lt t) = RedBlackTree eqIns eqLk lt t
----------------------------------------------------------------------------
-- implementation of red-black trees:
rbt :: RedBlackTree a -> Tree a
rbt (RedBlackTree _ _ _ t) = t
--- The colors of a node in a red-black tree.
data Color = Red | Black | DoublyBlack
deriving Eq
--- The structure of red-black trees.
data Tree a = Tree Color a (Tree a) (Tree a)
| Empty
isEmptyTree :: Tree _ -> Bool
isEmptyTree Empty = True
isEmptyTree (Tree _ _ _ _) = False
isBlack :: Tree _ -> Bool
isBlack Empty = True
isBlack (Tree c _ _ _) = c == Black
isRed :: Tree _ -> Bool
isRed Empty = False
isRed (Tree c _ _ _) = c == Red
isDoublyBlack :: Tree _ -> Bool
isDoublyBlack Empty = True
isDoublyBlack (Tree c _ _ _) = c == DoublyBlack
left :: Tree a -> Tree a
left Empty = error "RedBlackTree.left"
left (Tree _ _ l _) = l
right :: Tree a -> Tree a
right Empty = error "RedBlackTree.right"
right (Tree _ _ _ r) = r
singleBlack :: Tree a -> Tree a
singleBlack Empty = Empty
singleBlack (Tree Red x l r) = Tree Red x l r
singleBlack (Tree Black x l r) = Tree Black x l r
singleBlack (Tree DoublyBlack x l r) = Tree Black x l r
--- for the implementation of balanceL and balanceR refer to picture 3.5, page 27,
--- Okasaki "Purely Functional Data Structures"
balanceL :: Tree a -> Tree a
balanceL tree
| isRed leftTree && isRed (left leftTree)
= let Tree _ z (Tree _ y (Tree _ x a b) c) d = tree
in Tree Red y (Tree Black x a b) (Tree Black z c d)
| isRed leftTree && isRed (right leftTree)
= let Tree _ z (Tree _ x a (Tree _ y b c)) d = tree
in Tree Red y (Tree Black x a b) (Tree Black z c d)
| otherwise = tree
where
leftTree = left tree
balanceR :: Tree a -> Tree a
balanceR tree
| isRed rightTree && isRed (right rightTree)
= let Tree _ x a (Tree _ y b (Tree _ z c d)) = tree
in Tree Red y (Tree Black x a b) (Tree Black z c d)
| isRed rightTree && isRed (left rightTree)
= let Tree _ x a (Tree _ z (Tree _ y b c) d) = tree
in Tree Red y (Tree Black x a b) (Tree Black z c d)
| otherwise = tree
where
rightTree = right tree
--- balancing after deletion
delBalanceL :: Tree a -> Tree a
delBalanceL tree = if isDoublyBlack (left tree) then reviseLeft tree else tree
reviseLeft :: Tree a -> Tree a
reviseLeft tree
| isEmptyTree r = tree
| blackr && isRed (left r)
= let Tree col x a (Tree _ z (Tree _ y b c) d) = tree
in Tree col y (Tree Black x (singleBlack a) b) (Tree Black z c d)
| blackr && isRed (right r)
= let Tree col x a (Tree _ y b (Tree _ z c d)) = tree
in Tree col y (Tree Black x (singleBlack a) b) (Tree Black z c d)
| blackr
= let Tree col x a (Tree _ y b c) = tree
in Tree (if col==Red then Black else DoublyBlack) x (singleBlack a)
(Tree Red y b c)
| otherwise
= let Tree _ x a (Tree _ y b c) = tree
in Tree Black y (reviseLeft (Tree Red x a b)) c
where
r = right tree
blackr = isBlack r
delBalanceR :: Tree a -> Tree a
delBalanceR tree = if isDoublyBlack (right tree) then reviseRight tree
else tree
reviseRight :: Tree a -> Tree a
reviseRight tree
| isEmptyTree l = tree
| blackl && isRed (left l)
= let Tree col x (Tree _ y (Tree _ z d c) b) a = tree
in Tree col y (Tree Black z d c) (Tree Black x b (singleBlack a))
| blackl && isRed (right l)
= let Tree col x (Tree _ z d (Tree _ y c b)) a = tree
in Tree col y (Tree Black z d c) (Tree Black x b (singleBlack a))
| blackl
= let Tree col x (Tree _ y c b) a = tree
in Tree (if col==Red then Black
else DoublyBlack) x (Tree Red y c b) (singleBlack a)
| otherwise
= let Tree _ x (Tree _ y c b) a = tree
in Tree Black y c (reviseRight (Tree Red x b a))
where
l = left tree
blackl = isBlack l
SetRBT.curry deleted 100644 → 0
View file @ c8d0428b
----------------------------------------------------------------------------
--- Library with an implementation of sets as red-black trees.
---
--- All the operations on sets are generic, i.e., one has to provide
--- an explicit order predicate `(<)` (less-than) on elements.
---
--- @author Johannes Koj, Michael Hanus, Bernd Brassel
--- @version March 2013
--- @category algorithm
----------------------------------------------------------------------------
module SetRBT where
import qualified RedBlackTree as RBT
import Maybe (isJust)
type SetRBT a = RBT.RedBlackTree a
--- Returns an empty set, i.e., an empty red-black tree
--- augmented with an order predicate.
emptySetRBT :: Eq a => (a -> a -> Bool) -> SetRBT a
emptySetRBT = RBT.empty (==) (==)
--- Test for an empty set.
isEmptySetRBT :: SetRBT _ -> Bool
isEmptySetRBT = RBT.isEmpty
--- Returns true if an element is contained in a (red-black tree) set.
--- @param e - an element to be checked for containment
--- @param s - a set (represented as a red-black tree)
--- @return True if e is contained in s
elemRBT :: a -> SetRBT a -> Bool
elemRBT e = isJust . (RBT.lookup e)
--- Inserts an element into a set if it is not already there.
insertRBT :: a -> SetRBT a -> SetRBT a
insertRBT = RBT.update
--- Inserts an element into a multiset.
--- Thus, the same element can have several occurrences in the multiset.
insertMultiRBT :: Eq a => a -> SetRBT a -> SetRBT a
insertMultiRBT e = RBT.setInsertEquivalence (==)
. RBT.update e
. RBT.setInsertEquivalence (\ _ _ -> False)
--- delete an element from a set.
--- Deletes only a single element from a multi set
deleteRBT :: a -> SetRBT a -> SetRBT a
deleteRBT = RBT.delete
--- Transforms a (red-black tree) set into an ordered list of its elements.
setRBT2list :: SetRBT a -> [a]
setRBT2list = RBT.tree2list
--- Computes the union of two (red-black tree) sets.
--- This is done by inserting all elements of the first set into the
--- second set.
unionRBT :: SetRBT a -> SetRBT a -> SetRBT a
unionRBT s1 s2 = foldr insertRBT s2 (setRBT2list s1)
--- Computes the intersection of two (red-black tree) sets.
--- This is done by inserting all elements of the first set
--- contained in the second set into a new set, which order
--- is taken from the first set.
intersectRBT :: SetRBT a -> SetRBT a -> SetRBT a
intersectRBT s1 s2 = foldr insertRBT (RBT.newTreeLike s1)
(filter (`elemRBT` s2) (setRBT2list s1))
--- Generic sort based on insertion into red-black trees.
--- The first argument is the order for the elements.
sortRBT :: Eq a => (a -> a -> Bool) -> [a] -> [a]
sortRBT = RBT.sortBy
TableRBT.curry deleted 100644 → 0
View file @ c8d0428b
---------------------------------------------------------------------------
--- Library with an implementation of tables as red-black trees:
--- <P>
--- A table is a finite mapping from keys to values.
--- All the operations on tables are generic, i.e., one has to provide
--- an explicit order predicate ("<CODE>cmp</CODE>" below) on elements.
--- Each inner node in the red-black tree contains a key-value association.
---
--- @author Johannes Koj, Michael Hanus, Bernd Brassel
--- @version March 2005
--- @category algorithm
----------------------------------------------------------------------------
module TableRBT where
import qualified RedBlackTree as RBT
--import RedBlackTree (RedBlackTree) -- uncomment for old (buggy) Java front end
----------------------------------------------------------------------------
-- the main interface:
type TableRBT key a = RBT.RedBlackTree (key,a)
--- Returns an empty table, i.e., an empty red-black tree.
emptyTableRBT :: Eq a => (a -> a -> Bool) -> TableRBT a _
emptyTableRBT lt = RBT.empty (\ x y -> fst x==fst y)
(\ x y -> fst x==fst y)
(\ x y -> lt (fst x) (fst y))
--- tests whether a given table is empty
isEmptyTable :: TableRBT _ _ -> Bool
isEmptyTable = RBT.isEmpty
--- Looks up an entry in a table.
--- @param k - a key under which a value is stored
--- @param t - a table (represented as a red-black tree)
--- @return (Just v) if v is the value stored with key k,
--- otherwise Nothing is returned.
lookupRBT :: key -> TableRBT key a -> Maybe a
lookupRBT k = maybe Nothing (Just . snd) . RBT.lookup (k,failed)
--- Inserts or updates an element in a table.
updateRBT :: key -> a -> TableRBT key a -> TableRBT key a
updateRBT k e = RBT.update (k,e)
--- Transforms the nodes of red-black tree into a list.
tableRBT2list :: TableRBT key a -> [(key,a)]
tableRBT2list = RBT.tree2list
deleteRBT :: key -> TableRBT key a -> TableRBT key a
deleteRBT key = RBT.delete (key,failed)
-- end of TableRBT
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment