summaryrefslogtreecommitdiff
path: root/src/GF/Data/RedBlackSet.hs
diff options
context:
space:
mode:
authoraarne <aarne@cs.chalmers.se>2008-06-25 16:43:48 +0000
committeraarne <aarne@cs.chalmers.se>2008-06-25 16:43:48 +0000
commitb96b36f43de3e2f8b58d5f539daa6f6d47f25870 (patch)
tree0992334be13cec6538a1dea22fbbf26ad6bdf224 /src/GF/Data/RedBlackSet.hs
parentfe367412e0aeb4ad5c02de68e6eca382e0f96984 (diff)
removed src for 2.9
Diffstat (limited to 'src/GF/Data/RedBlackSet.hs')
-rw-r--r--src/GF/Data/RedBlackSet.hs150
1 files changed, 0 insertions, 150 deletions
diff --git a/src/GF/Data/RedBlackSet.hs b/src/GF/Data/RedBlackSet.hs
deleted file mode 100644
index 8a1b8a743..000000000
--- a/src/GF/Data/RedBlackSet.hs
+++ /dev/null
@@ -1,150 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module : RedBlackSet
--- Maintainer : Peter Ljunglöf
--- Stability : Stable
--- Portability : Haskell 98
---
--- > CVS $Date: 2005/03/21 14:17:39 $
--- > CVS $Author: peb $
--- > CVS $Revision: 1.1 $
---
--- Modified version of Okasaki's red-black trees
--- incorporating sets and set-valued maps
-----------------------------------------------------------------------
-
-module GF.Data.RedBlackSet ( -- * Red-black sets
- RedBlackSet,
- rbEmpty,
- rbList,
- rbElem,
- rbLookup,
- rbInsert,
- rbMap,
- rbOrdMap,
- -- * Red-black finite maps
- RedBlackMap,
- rbmEmpty,
- rbmList,
- rbmElem,
- rbmLookup,
- rbmInsert,
- rbmOrdMap
- ) where
-
---------------------------------------------------------------------------------
--- sets
-
-data Color = R | B deriving (Eq, Show)
-data RedBlackSet a = E | T Color (RedBlackSet a) a (RedBlackSet a)
- deriving (Eq, Show)
-
-rbBalance B (T R (T R a x b) y c) z d = T R (T B a x b) y (T B c z d)
-rbBalance B (T R a x (T R b y c)) z d = T R (T B a x b) y (T B c z d)
-rbBalance B a x (T R (T R b y c) z d) = T R (T B a x b) y (T B c z d)
-rbBalance B a x (T R b y (T R c z d)) = T R (T B a x b) y (T B c z d)
-rbBalance color a x b = T color a x b
-
-rbBlack (T _ a x b) = T B a x b
-
--- | the empty set
-rbEmpty :: RedBlackSet a
-rbEmpty = E
-
--- | the elements of a set as a sorted list
-rbList :: RedBlackSet a -> [a]
-rbList tree = rbl tree []
- where rbl E = id
- rbl (T _ left a right) = rbl right . (a:) . rbl left
-
--- | checking for containment
-rbElem :: Ord a => a -> RedBlackSet a -> Bool
-rbElem _ E = False
-rbElem a (T _ left a' right)
- = case compare a a' of
- LT -> rbElem a left
- GT -> rbElem a right
- EQ -> True
-
--- | looking up a key in a set of keys and values
-rbLookup :: Ord k => k -> RedBlackSet (k, a) -> Maybe a
-rbLookup _ E = Nothing
-rbLookup a (T _ left (a',b) right)
- = case compare a a' of
- LT -> rbLookup a left
- GT -> rbLookup a right
- EQ -> Just b
-
--- | inserting a new element.
--- returns 'Nothing' if the element is already contained
-rbInsert :: Ord a => a -> RedBlackSet a -> Maybe (RedBlackSet a)
-rbInsert value tree = fmap rbBlack (rbins tree)
- where rbins E = Just (T R E value E)
- rbins (T color left value' right)
- = case compare value value' of
- LT -> do left' <- rbins left
- return (rbBalance color left' value' right)
- GT -> do right' <- rbins right
- return (rbBalance color left value' right')
- EQ -> Nothing
-
--- | mapping each value of a key-value set
-rbMap :: (a -> b) -> RedBlackSet (k, a) -> RedBlackSet (k, b)
-rbMap f E = E
-rbMap f (T color left (key, value) right)
- = T color (rbMap f left) (key, f value) (rbMap f right)
-
--- | mapping each element to another type.
--- /observe/ that the mapping function needs to preserve
--- the order between objects
-rbOrdMap :: (a -> b) -> RedBlackSet a -> RedBlackSet b
-rbOrdMap f E = E
-rbOrdMap f (T color left value right)
- = T color (rbOrdMap f left) (f value) (rbOrdMap f right)
-
-----------------------------------------------------------------------
--- finite maps
-
-type RedBlackMap k a = RedBlackSet (k, RedBlackSet a)
-
--- | the empty map
-rbmEmpty :: RedBlackMap k a
-rbmEmpty = E
-
--- | converting a map to a key-value list, sorted on the keys,
--- and for each key, a sorted list of values
-rbmList :: RedBlackMap k a -> [(k, [a])]
-rbmList tree = [ (k, rbList sub) | (k, sub) <- rbList tree ]
-
--- | checking whether a key-value pair is contained in the map
-rbmElem :: (Ord k, Ord a) => k -> a -> RedBlackMap k a -> Bool
-rbmElem key value = maybe False (rbElem value) . rbLookup key
-
--- | looking up a key, returning a (sorted) list of all matching values
-rbmLookup :: Ord k => k -> RedBlackMap k a -> [a]
-rbmLookup key = maybe [] rbList . rbLookup key
-
--- | inserting a key-value pair.
--- returns 'Nothing' if the pair is already contained in the map
-rbmInsert :: (Ord k, Ord a) => k -> a -> RedBlackMap k a -> Maybe (RedBlackMap k a)
-rbmInsert key value tree = fmap rbBlack (rbins tree)
- where rbins E = Just (T R E (key, T B E value E) E)
- rbins (T color left item@(key', vtree) right)
- = case compare key key' of
- LT -> do left' <- rbins left
- return (rbBalance color left' item right)
- GT -> do right' <- rbins right
- return (rbBalance color left item right')
- EQ -> do vtree' <- rbInsert value vtree
- return (T color left (key', vtree') right)
-
--- | mapping each value to another type.
--- /observe/ that the mapping function needs to preserve
--- order between objects
-rbmOrdMap :: (a -> b) -> RedBlackMap k a -> RedBlackMap k b
-rbmOrdMap f E = E
-rbmOrdMap f (T color left (key, tree) right)
- = T color (rbmOrdMap f left) (key, rbOrdMap f tree) (rbmOrdMap f right)
-
-
-