IntervalMap 0.4.1.0 → 0.4.1.1
raw patch · 8 files changed
+1292/−1 lines, 8 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- IntervalMap.cabal +2/−1
- bench/IntRange.hs +15/−0
- bench/IvMapSortedList.hs +60/−0
- bench/RBColorInt.hs +107/−0
- bench/RBColorIntBase.hs +557/−0
- bench/RBColorNode.hs +96/−0
- bench/RBColorNodeBase.hs +453/−0
- changelog +2/−0
IntervalMap.cabal view
@@ -1,5 +1,5 @@ Name: IntervalMap-Version: 0.4.1.0+Version: 0.4.1.1 Stability: experimental Synopsis: Maps from Intervals to values, with efficient search. Homepage: http://www.chr-breitkopf.de/comp/IntervalMap@@ -22,6 +22,7 @@ README.md changelog test/*.hs+ bench/*.hs examples/*.lhs Flag HPC
+ bench/IntRange.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE MultiParamTypeClasses #-}++module IntRange (IntRange(..), Interval(..)) where++import Data.IntervalMap.Generic.Interval+import Control.DeepSeq++data IntRange = IntRange {-# UNPACK #-} !Int {-# UNPACK #-} !Int deriving (Eq, Ord, Show)++instance Interval IntRange Int where+ lowerBound (IntRange lo _) = lo+ upperBound (IntRange _ hi) = hi++instance NFData IntRange where+ rnf a = a `seq` ()
+ bench/IvMapSortedList.hs view
@@ -0,0 +1,60 @@+module IvMapSortedList (IVS, size, empty, singleton, insert, insertWithKey, lookup, containing, fromList) where++import Prelude hiding (lookup)+import Data.IntervalMap.Generic.Interval+import Control.DeepSeq+import Data.List (sortBy)+++data Entry k v = E !k !v deriving (Eq, Ord, Show)++instance (NFData k, NFData v) => NFData (Entry k v) where+ rnf (E k v) = k `deepseq` v `deepseq` ()++newtype IVS k v = IVS [Entry k v] deriving (Eq, Ord, Show)++instance (NFData k, NFData v) => NFData (IVS k v) where+ rnf (IVS v) = v `deepseq` ()++size :: IVS k v -> Int+size (IVS es) = length es++empty :: IVS k v+empty = IVS []++singleton :: k -> v -> IVS k v+singleton k v = IVS [E k v]++insert :: Ord k => k -> v -> IVS k v -> IVS k v+insert = insertWithKey (\_ val _ -> val)++insertWithKey :: Ord k => (k -> v -> v -> v) -> k -> v -> IVS k v -> IVS k v+insertWithKey f key val (IVS m) = IVS (go m)+ where+ go [] = [E key val] + go es@(e@(E k v) : es') = case compare key k of+ GT -> e : go es'+ LT -> E key val : es+ EQ -> E key (f key val v) : es'++lookup :: Ord k => k -> IVS k v -> Maybe v+lookup key (IVS m) = key `seq` go m+ where+ go (E k v : es) = case compare key k of+ GT -> go es+ EQ -> Just v+ LT -> Nothing+ go [] = Nothing+++containing :: (Interval k e) => IVS k v -> e -> [(k, v)]+(IVS m) `containing` p = p `seq` go m+ where+ go (E k v : es) | p `above` k = go es+ | p `below` k = []+ | otherwise = (k,v) : go es+ go [] = []++fromList :: Ord k => [(k, v)] -> IVS k v+fromList = foldr (\(k,v) m -> insert k v m) empty . sortBy cmpKey+ where cmpKey (k1,_) (k2,_) = compare k1 k2
+ bench/RBColorInt.hs view
@@ -0,0 +1,107 @@+module RBColorInt (+ -- * re-export+ Interval(..)+ -- * Map type+ , IntervalMap -- instance Eq,Show,Read++ -- * Operators+ , (!)++ -- * Query+ , null+ , size+ , member+ , notMember+ , lookup+ , findWithDefault++ -- ** Interval query+ , containing+ , intersecting+ , within+ + -- * Construction+ , empty+ , singleton++ -- * Conversion+ , elems+ , keys+ , keysSet+ , assocs++ -- ** Lists+ , toList++ -- ** Ordered lists+ , toAscList+ , toDescList+ , fromAscList+ , fromAscListWith+ , fromAscListWithKey+ , fromDistinctAscList++ -- * Min\/Max+ , findMin+ , findMax+ , findLast++ -- * Debugging+ , valid++ -- * Testing+ , height, maxHeight, showStats++ ) where++import Prelude hiding (null, lookup, map, filter, foldr, foldl)+import RBColorIntBase as M hiding (+ singleton+ , findWithDefault+ , fromAscList+ , fromAscListWith+ , fromAscListWithKey+ )++cBLACK :: Int+cBLACK = 1++ +-- | /O(1)/. A map with one entry.+singleton :: k -> v -> IntervalMap k v+singleton k v = v `seq` Node cBLACK k k v Nil Nil+++-- | /O(log n)/. The expression @('findWithDefault' def k map)@ returns+-- the value at key @k@ or returns default value @def@+-- when the key is not in the map.+--+-- > findWithDefault 'x' 1 (fromList [(5,'a'), (3,'b')]) == 'x'+-- > findWithDefault 'x' 5 (fromList [(5,'a'), (3,'b')]) == 'a'+findWithDefault :: Ord k => a -> k -> IntervalMap k a -> a+findWithDefault def k m = def `seq` case M.lookup k m of+ Nothing -> def+ Just x -> x++-- | /O(n)/. Build a map from an ascending list in linear time.+-- /The precondition (input list is ascending) is not checked./+fromAscList :: (Interval k e, Eq k) => [(k,v)] -> IntervalMap k v+fromAscList xs = fromAscListWith (\_ b -> b) xs++-- | /O(n)/. Build a map from an ascending list in linear time with a combining function for equal keys.+-- /The precondition (input list is ascending) is not checked./+fromAscListWith :: (Interval k e, Eq k) => (a -> a -> a) -> [(k,a)] -> IntervalMap k a +fromAscListWith f xs = fromAscListWithKey (\_ a b -> f a b) xs++-- | /O(n)/. Build a map from an ascending list in linear time with a combining function for equal keys.+-- /The precondition (input list is ascending) is not checked./+fromAscListWithKey :: (Interval k e, Eq k) => (k -> a -> a -> a) -> [(k,a)] -> IntervalMap k a+fromAscListWithKey f xs = fromDistinctAscList (combineEq f xs)++combineEq :: Eq k => (k -> a -> a -> a) -> [(k,a)] -> [(k,a)]+combineEq _ [] = []+combineEq _ xs@[_] = xs+combineEq f (x@(xk,xv) : xs@((yk,yv) : xs'))+ | xk == yk = let v' = f xk xv yv in v' `seq` combineEq f ((xk, v') : xs')+ | otherwise = x : combineEq f xs+
+ bench/RBColorIntBase.hs view
@@ -0,0 +1,557 @@+-- Version of IntervalMap where Color is an Int+-- Only lookup and fromDistinctAscList are supported+--+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE FlexibleContexts #-}+module RBColorIntBase (+ -- * re-export+ Interval(..)+ -- * Map type+ , IntervalMap(..) -- instance Eq,Show,Read++ -- * Operators+ , (!)++ -- * Query+ , null+ , size+ , member+ , notMember+ , lookup+ , findWithDefault++ -- ** Interval query+ , containing+ , intersecting+ , within+ + -- * Construction+ , empty+ , singleton++ -- * Conversion+ , elems+ , keys+ , keysSet+ , assocs++ -- ** Lists+ , toList++ -- ** Ordered lists+ , toAscList+ , toDescList+ , fromAscList+ , fromAscListWith+ , fromAscListWithKey+ , fromDistinctAscList++ -- * Min\/Max+ , findMin+ , findMax+ , findLast++ -- * Internal, not re-exported by Data.IntervalMap.{Lazy,Strict}+ , Color(..)+ , turnBlack++ -- * Debugging+ , valid++ -- * Testing+ , height, maxHeight, showStats++ ) where++import Prelude hiding (null, lookup, map, filter, foldr, foldl)+import Data.Bits (shiftR, (.&.))+import Data.Monoid (Monoid(..))+import Control.Applicative (Applicative(..), (<$>))+import Data.Traversable (Traversable(traverse))+import qualified Data.Foldable as Foldable+import qualified Data.List as L+import qualified Data.Set as Set+import Control.DeepSeq++import Data.IntervalMap.Generic.Interval++{--------------------------------------------------------------------+ Operators+--------------------------------------------------------------------}+infixl 9 !++-- | /O(log n)/. Lookup value for given key. Calls 'error' if the key is not in the map.+--+-- Use 'lookup' or 'findWithDefault' instead of this function, unless you are absolutely+-- sure that the key is present in the map.+(!) :: (Interval k e, Ord k) => IntervalMap k v -> k -> v+tree ! key = case lookup key tree of+ Just v -> v+ Nothing -> error "IntervalMap.!: key not found"+++-- data Color = R | B deriving (Eq, Read, Show)+type Color = Int+cRED, cBLACK :: Int+cRED = 0+cBLACK = 1++-- | A map from intervals of type @k@ to values of type @v@.+data IntervalMap k v = Nil+ | Node {-# UNPACK #-} !Int+ !k -- key+ !k -- interval with maximum upper in tree+ v -- value+ !(IntervalMap k v) -- left subtree+ !(IntervalMap k v) -- right subtree++instance (Eq k, Eq v) => Eq (IntervalMap k v) where+ a == b = toAscList a == toAscList b++instance (Ord k, Ord v) => Ord (IntervalMap k v) where+ compare a b = compare (toAscList a) (toAscList b)++instance Functor (IntervalMap k) where+ fmap f m = map f m++instance Traversable (IntervalMap k) where+ traverse _ Nil = pure Nil+ traverse f (Node c k m v l r)+ = flip (Node c k m) <$> traverse f l <*> f v <*> traverse f r++instance Foldable.Foldable (IntervalMap k) where+ fold Nil = mempty+ fold (Node _ _ _ v l r) = Foldable.fold l `mappend` v `mappend` Foldable.fold r+ foldr = foldr+ foldl = foldl+ foldMap _ Nil = mempty+ foldMap f (Node _ _ _ v l r) = Foldable.foldMap f l `mappend` f v `mappend` Foldable.foldMap f r++instance (NFData k, NFData a) => NFData (IntervalMap k a) where+ rnf Nil = ()+ rnf (Node _ kx _ x l r) = kx `deepseq` x `deepseq` l `deepseq` r `deepseq` ()++instance (Show k, Show a) => Show (IntervalMap k a) where+ showsPrec d m = showParen (d > 10) $+ showString "fromList " . shows (toList m)+++isRed :: IntervalMap k v -> Bool+isRed (Node 0 _ _ _ _ _) = True+isRed _ = False++turnBlack :: IntervalMap k v -> IntervalMap k v+turnBlack (Node 0 k m vs l r) = Node cBLACK k m vs l r+turnBlack t = t++turnRed :: IntervalMap k v -> IntervalMap k v+turnRed Nil = error "turnRed: Leaf"+turnRed (Node 1 k m v l r) = Node cRED k m v l r+turnRed t = t++-- construct node, recomputing the upper key bound.+mNode :: (Interval k e) => Color -> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v+mNode c k v l r = Node c k (maxUpper k l r) v l r++maxUpper :: (Interval i k) => i -> IntervalMap i v -> IntervalMap i v -> i+maxUpper k Nil Nil = k `seq` k+maxUpper k Nil (Node _ _ m _ _ _) = maxByUpper k m+maxUpper k (Node _ _ m _ _ _) Nil = maxByUpper k m+maxUpper k (Node _ _ l _ _ _) (Node _ _ r _ _ _) = maxByUpper k (maxByUpper l r)++-- interval with the greatest upper bound. The lower bound is ignored!+maxByUpper :: (Interval i e) => i -> i -> i+maxByUpper a b | rightClosed a = if upperBound a >= upperBound b then a else b+ | otherwise = if upperBound a > upperBound b then a else b++-- ---------------------------------------------------------++-- | /O(1)/. The empty map.+empty :: IntervalMap k v+empty = Nil++-- | /O(1)/. A map with one entry.+singleton :: k -> v -> IntervalMap k v+singleton k v = Node cBLACK k k v Nil Nil+++-- | /O(1)/. Is the map empty?+null :: IntervalMap k v -> Bool+null Nil = True+null _ = False++-- | /O(n)/. Number of keys in the map.+--+-- Caution: unlike 'Data.Map.size', which takes constant time, this is linear in the+-- number of keys!+size :: IntervalMap k v -> Int+size t = h 0 t+ where+ h n m = n `seq` case m of+ Nil -> n+ Node _ _ _ _ l r -> h (h n l + 1) r++-- | The height of the tree. For testing/debugging only.+height :: IntervalMap k v -> Int+height Nil = 0+height (Node _ _ _ _ l r) = 1 + max (height l) (height r)++-- | The maximum height of a red-black tree with the given number of nodes.+-- For testing/debugging only.+maxHeight :: Int -> Int+maxHeight nodes = 2 * log2 (nodes + 1)++-- | Tree statistics (size, height, maxHeight size).+-- For testing/debugging only.+showStats :: IntervalMap k a -> (Int, Int, Int)+showStats m = (n, height m, maxHeight n)+ where n = size m++-- | /O(log n)/. Does the map contain the given key? See also 'notMember'.+member :: (Ord k) => k -> IntervalMap k v -> Bool+member key tree = case lookup key tree of+ Nothing -> False+ Just _ -> True++-- | /O(log n)/. Does the map not contain the given key? See also 'member'.+notMember :: (Ord k) => k -> IntervalMap k v -> Bool+notMember key tree = not (member key tree)+++-- | /O(log n)/. Look up the given key in the map, returning the value @('Just' value)@,+-- or 'Nothing' if the key is not in the map.+lookup :: (Ord k) => k -> IntervalMap k v -> Maybe v+lookup k Nil = k `seq` Nothing+lookup k (Node _ key _ v l r) = case compare k key of+ LT -> lookup k l+ GT -> lookup k r+ EQ -> Just v+++-- | /O(log n)/. The expression @('findWithDefault' def k map)@ returns+-- the value at key @k@ or returns default value @def@+-- when the key is not in the map.+findWithDefault :: Ord k => a -> k -> IntervalMap k a -> a+findWithDefault def k m = case lookup k m of+ Nothing -> def+ Just x -> x++-- | Return all key/value pairs where the key intervals contain the given point.+-- The elements are returned in ascending key order.+--+-- /O(n)/, since potentially all keys could contain the point.+-- /O(log n)/ average case. This is also the worst case for maps containing no overlapping keys.+containing :: (Interval k e) => IntervalMap k v -> e -> [(k, v)]+t `containing` pt = go [] pt t+ where+ go xs p Nil = p `seq` xs+ go xs p (Node _ k m v l r)+ | p `above` m = xs -- above all intervals in the tree: no result+ | p `below` k = go xs p l -- to the left of the lower bound: can't be in right subtree+ | p `inside` k = go ((k,v) : go xs p r) p l+ | otherwise = go (go xs p r) p l++-- | Return all key/value pairs where the key intervals overlap (intersect) the given interval.+-- The elements are returned in ascending key order.+--+-- /O(n)/, since potentially all keys could intersect the interval.+-- /O(log n)/ average case, if few keys intersect the interval.+intersecting :: (Interval k e) => IntervalMap k v -> k -> [(k, v)]+t `intersecting` iv = go [] iv t+ where+ go xs i Nil = i `seq` xs+ go xs i (Node _ k m v l r)+ | i `after` m = xs+ | i `before` k = go xs i l+ | i `overlaps` k = go ((k,v) : go xs i r) i l+ | otherwise = go (go xs i r) i l++-- | Return all key/value pairs where the key intervals are completely inside the given interval.+-- The elements are returned in ascending key order.+--+-- /O(n)/, since potentially all keys could be inside the interval.+-- /O(log n)/ average case, if few keys are inside the interval.+within :: (Interval k e) => IntervalMap k v -> k -> [(k, v)]+t `within` iv = go [] iv t+ where+ go xs i Nil = i `seq` xs+ go xs i (Node _ k m v l r)+ | i `after` m = xs+ | i `before` k = go xs i l+ | i `subsumes` k = go ((k,v) : go xs i r) i l+ | otherwise = go (go xs i r) i l+++-- min/max++-- | /O(log n)/. Returns the smallest key and its associated value.+-- Calls 'error' if the map is empty.+findMin :: IntervalMap k v -> (k, v)+findMin (Node _ k _ v Nil _) = (k,v)+findMin (Node _ _ _ _ l _) = findMin l+findMin Nil = error "IntervalMap.findMin: empty map"++-- | /O(log n)/. Returns the largest key and its associated value.+-- Calls 'error' if the map is empty.+findMax :: IntervalMap k v -> (k, v)+findMax (Node _ k _ v _ Nil) = (k,v)+findMax (Node _ _ _ _ _ r) = findMax r+findMax Nil = error "IntervalMap.findMin: empty map"++-- | Returns the interval with the largest endpoint.+-- If there is more than one interval with that endpoint,+-- return the rightmost.+--+-- /O(n)/, since all keys could have the same endpoint.+-- /O(log n)/ average case.+findLast :: (Interval k e) => IntervalMap k v -> (k, v)+findLast Nil = error "IntervalMap.findLast: empty map"+findLast t@(Node _ _ mx _ _ _) = lastMax+ where+ (lastMax : _) = go t+ go Nil = []+ go (Node _ k m v l r) | sameU m mx = if sameU k m then go r ++ ((k,v) : go l)+ else go r ++ go l+ | otherwise = []+ sameU a b = upperBound a == upperBound b && rightClosed a == rightClosed b+++-- folding++-- | /O(n)/. Fold the values in the map using the given right-associative+-- binary operator, such that @'foldr' f z == 'Prelude.foldr' f z . 'elems'@.+foldr :: (a -> b -> b) -> b -> IntervalMap k a -> b+foldr _ z Nil = z+foldr f z (Node _ _ _ x l r) = foldr f (f x (foldr f z r)) l++-- | /O(n)/. A strict version of 'foldr'. Each application of the operator is+-- evaluated before using the result in the next application. This+-- function is strict in the starting value.+foldr' :: (a -> b -> b) -> b -> IntervalMap k a -> b+foldr' f z m = z `seq` case m of+ Nil -> z+ Node _ _ _ x l r -> foldr' f (f x (foldr' f z r)) l++-- | /O(n)/. Fold the values in the map using the given left-associative+-- binary operator, such that @'foldl' f z == 'Prelude.foldl' f z . 'elems'@.+foldl :: (b -> a -> b) -> b -> IntervalMap k a -> b+foldl _ z Nil = z+foldl f z (Node _ _ _ x l r) = foldl f (f (foldl f z l) x) r++-- | /O(n)/. A strict version of 'foldl'. Each application of the operator is+-- evaluated before using the result in the next application. This+-- function is strict in the starting value.+foldl' :: (b -> a -> b) -> b -> IntervalMap k a -> b+foldl' f z m = z `seq` case m of+ Nil -> z+ Node _ _ _ x l r -> foldl' f (f (foldl' f z l) x) r++-- | /O(n)/. Fold the keys and values in the map using the given right-associative+-- binary operator, such that+-- @'foldrWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@.+foldrWithKey :: (k -> v -> a -> a) -> a -> IntervalMap k v -> a+foldrWithKey _ z Nil = z+foldrWithKey f z (Node _ k _ x l r) = foldrWithKey f (f k x (foldrWithKey f z r)) l++-- | /O(n)/. A strict version of 'foldrWithKey'. Each application of the operator is+-- evaluated before using the result in the next application. This+-- function is strict in the starting value.+foldrWithKey' :: (k -> v -> a -> a) -> a -> IntervalMap k v -> a+foldrWithKey' f z m = z `seq` case m of+ Nil -> z+ Node _ k _ x l r -> foldrWithKey' f (f k x (foldrWithKey' f z r)) l++-- | /O(n)/. Fold the keys and values in the map using the given left-associative+-- binary operator, such that+-- @'foldlWithKey' f z == 'Prelude.foldl' (\\z' (kx, x) -> f z' kx x) z . 'toAscList'@.+foldlWithKey :: (a -> k -> v -> a) -> a -> IntervalMap k v -> a+foldlWithKey _ z Nil = z+foldlWithKey f z (Node _ k _ x l r) = foldlWithKey f (f (foldlWithKey f z l) k x) r++-- | /O(n)/. A strict version of 'foldlWithKey'. Each application of the operator is+-- evaluated before using the result in the next application. This+-- function is strict in the starting value.+foldlWithKey' :: (a -> k -> v -> a) -> a -> IntervalMap k v -> a+foldlWithKey' f z m = z `seq` case m of+ Nil -> z+ Node _ k _ x l r -> foldlWithKey' f (f (foldlWithKey' f z l) k x) r++-- --- Conversion ---++-- | /O(n)/. The list of all key\/value pairs contained in the map, in ascending order of keys.+toAscList :: IntervalMap k v -> [(k,v)]+toAscList m = foldrWithKey (\k v r -> (k,v) : r) [] m++-- | /O(n)/. The list of all key\/value pairs contained in the map, in no particular order.+toList :: IntervalMap k v -> [(k,v)]+toList m = toAscList m++-- | /O(n)/. The list of all key\/value pairs contained in the map, in descending order of keys.+toDescList :: IntervalMap k v -> [(k, v)]+toDescList m = foldlWithKey (\r k v -> (k,v) : r) [] m++-- | /O(n)/. Build a map from an ascending list in linear time.+-- /The precondition (input list is ascending) is not checked./+fromAscList :: (Interval k e, Eq k) => [(k,v)] -> IntervalMap k v+fromAscList xs = fromAscListWith (\_ b -> b) xs++-- | /O(n)/. Build a map from an ascending list in linear time with a combining function for equal keys.+-- /The precondition (input list is ascending) is not checked./+fromAscListWith :: (Interval k e, Eq k) => (a -> a -> a) -> [(k,a)] -> IntervalMap k a +fromAscListWith f xs = fromAscListWithKey (\_ a b -> f a b) xs++-- | /O(n)/. Build a map from an ascending list in linear time with a combining function for equal keys.+-- /The precondition (input list is ascending) is not checked./+fromAscListWithKey :: (Interval k e, Eq k) => (k -> a -> a -> a) -> [(k,a)] -> IntervalMap k a +fromAscListWithKey f xs = fromDistinctAscList (combineEq f xs)++combineEq :: Eq k => (k -> a -> a -> a) -> [(k,a)] -> [(k,a)]+combineEq _ [] = []+combineEq _ xs@[_] = xs+combineEq f (x@(xk,xv) : xs@((yk,yv) : xs'))+ | xk == yk = combineEq f ((xk, f xk xv yv) : xs')+ | otherwise = x : combineEq f xs+++-- Strict tuple+data T2 a b = T2 !a !b+++-- | /O(n)/. Build a map from an ascending list of elements with distinct keys in linear time.+-- /The precondition is not checked./+fromDistinctAscList :: (Interval k e) => [(k,v)] -> IntervalMap k v+-- exactly 2^n-1 items have height n. They can be all black+-- from 2^n - 2^n-2 items have height n+1. The lowest "row" should be red.+fromDistinctAscList lyst = case h (length lyst) lyst of+ (T2 result []) -> result+ _ -> error "fromDistinctAscList: list not fully consumed"+ where+ h n xs | n == 0 = T2 Nil xs+ | isPerfect n = buildB n xs+ | otherwise = buildR n (log2 n) xs++ buildB n xs | xs `seq` n <= 0 = error "fromDictinctAscList: buildB 0"+ | n == 1 = case xs of ((k,v):xs') -> T2 (Node cBLACK k k v Nil Nil) xs'+ _ -> error "fromDictinctAscList: buildB 1"+ | otherwise =+ case n `quot` 2 of { n' ->+ case buildB n' xs of { (T2 _ []) -> error "fromDictinctAscList: buildB n";+ (T2 l ((k,v):xs')) ->+ case buildB n' xs' of { (T2 r xs'') ->+ T2 (mNode cBLACK k v l r) xs'' }}}++ buildR n d xs | d `seq` xs `seq` n == 0 = T2 Nil xs+ | n == 1 = case xs of ((k,v):xs') -> T2 (Node (if d==0 then cRED else cBLACK) k k v Nil Nil) xs'+ _ -> error "fromDistinctAscList: buildR 1"+ | otherwise =+ case n `quot` 2 of { n' ->+ case buildR n' (d-1) xs of { (T2 _ []) -> error "fromDistinctAscList: buildR n";+ (T2 l ((k,v):xs')) ->+ case buildR (n - (n' + 1)) (d-1) xs' of { (T2 r xs'') ->+ T2 (mNode cBLACK k v l r) xs'' }}}+++-- is n a perfect binary tree size (2^m-1)?+isPerfect :: Int -> Bool+isPerfect n = (n .&. (n + 1)) == 0++log2 :: Int -> Int+log2 m = h (-1) m+ where+ h r n | r `seq` n <= 0 = r+ | otherwise = h (r + 1) (n `shiftR` 1)+++-- | /O(n)/. List of all values in the map, in ascending order of their keys.+elems :: IntervalMap k v -> [v]+elems m = [v | (_,v) <- toAscList m]++-- | /O(n)/. List of all keys in the map, in ascending order.+keys :: IntervalMap k v -> [k]+keys m = [k | (k,_) <- toAscList m]++-- | /O(n)/. Set of the keys.+keysSet :: (Ord k) => IntervalMap k v -> Set.Set k+keysSet m = Set.fromDistinctAscList (keys m)++-- | Same as 'toAscList'.+assocs :: IntervalMap k v -> [(k, v)]+assocs m = toAscList m++-- --- Mapping ---++-- | /O(n)/. Map a function over all values in the map.+map :: (a -> b) -> IntervalMap k a -> IntervalMap k b+map f = mapWithKey (\_ x -> f x)++-- | /O(n)/. Map a function over all values in the map.+mapWithKey :: (k -> a -> b) -> IntervalMap k a -> IntervalMap k b+mapWithKey f = go+ where+ go Nil = Nil+ go (Node c k m v l r) = Node c k m (f k v) (go l) (go r)++-- | /O(n)/. The function 'mapAccum' threads an accumulating+-- argument through the map in ascending order of keys.+mapAccum :: (a -> b -> (a,c)) -> a -> IntervalMap k b -> (a, IntervalMap k c)+mapAccum f a m = mapAccumWithKey (\a' _ x' -> f a' x') a m++-- | /O(n)/. The function 'mapAccumWithKey' threads an accumulating+-- argument through the map in ascending order of keys.+mapAccumWithKey :: (a -> k -> b -> (a,c)) -> a -> IntervalMap k b -> (a, IntervalMap k c)+mapAccumWithKey f = go+ where+ go a Nil = (a,Nil)+ go a (Node c kx m x l r) =+ let (a1,l') = go a l+ (a2,x') = f a1 kx x+ (a3,r') = go a2 r+ in (a3, Node c kx m x' l' r')++-- | /O(n)/. The function 'mapAccumRWithKey' threads an accumulating+-- argument through the map in descending order of keys.+mapAccumRWithKey :: (a -> k -> b -> (a,c)) -> a -> IntervalMap k b -> (a, IntervalMap k c)+mapAccumRWithKey f = go+ where+ go a Nil = (a, Nil)+ go a (Node c kx m x l r) =+ let (a1,r') = go a r+ (a2,x') = f a1 kx x+ (a3,l') = go a2 l+ in (a3, Node c kx m x' l' r')++-- debugging++-- | Check red-black-tree and interval search augmentation invariants.+-- For testing/debugging only.+valid :: (Interval i k, Ord i) => IntervalMap i v -> Bool+valid mp = test mp && height mp <= maxHeight (size mp) && validColor mp+ where+ test Nil = True+ test n@(Node _ _ _ _ l r) = validOrder n && validMax n && test l && test r+ validMax (Node _ k m _ lo hi) = m == maxUpper k lo hi+ validMax Nil = True++ validOrder (Node _ _ _ _ Nil Nil) = True+ validOrder (Node _ k1 _ _ Nil (Node _ k2 _ _ _ _)) = k1 < k2+ validOrder (Node _ k2 _ _ (Node _ k1 _ _ _ _) Nil) = k1 < k2+ validOrder (Node _ k2 _ _ (Node _ k1 _ _ _ _) (Node _ k3 _ _ _ _)) = k1 < k2 && k2 < k3+ validOrder Nil = True++ -- validColor parentColor blackCount tree+ validColor n = blackDepth n >= 0++ -- return -1 if subtrees have diffrent black depths or two consecutive red nodes are encountered+ blackDepth :: IntervalMap k v -> Int+ blackDepth Nil = 0+ blackDepth (Node c _ _ _ l r) = case blackDepth l of+ ld -> if ld < 0 then ld+ else+ case blackDepth r of+ rd -> if rd < 0 then rd+ else if rd /= ld then -1+ else if c == cRED && (isRed l || isRed r) then -1+ else if c == cBLACK then rd + 1+ else rd+
+ bench/RBColorNode.hs view
@@ -0,0 +1,96 @@+module RBColorNode (+ -- * re-export+ Interval(..)+ -- * Map type+ , IntervalMap -- instance Eq,Show,Read++ -- * Operators+ , (!)++ -- * Query+ , null+ , size+ , member+ , notMember+ , lookup+ , findWithDefault++ -- ** Interval query+ , containing+ , intersecting+ , within+ + -- * Construction+ , empty+ , singleton++ -- * Conversion+ , elems+ , keys+ , keysSet+ , assocs++ -- ** Lists+ , toList++ -- ** Ordered lists+ , toAscList+ , toDescList+ , fromAscList+ , fromAscListWith+ , fromAscListWithKey+ , fromDistinctAscList++ -- * Testing+ , height, maxHeight, showStats++ ) where++import Prelude hiding (null, lookup, map, filter, foldr, foldl)+import RBColorNodeBase as M hiding (+ singleton+ , findWithDefault+ , fromAscList+ , fromAscListWith+ , fromAscListWithKey+ )++ +-- | /O(1)/. A map with one entry.+singleton :: k -> v -> IntervalMap k v+singleton k v = v `seq` NodeB k k v Nil Nil+++-- | /O(log n)/. The expression @('findWithDefault' def k map)@ returns+-- the value at key @k@ or returns default value @def@+-- when the key is not in the map.+--+-- > findWithDefault 'x' 1 (fromList [(5,'a'), (3,'b')]) == 'x'+-- > findWithDefault 'x' 5 (fromList [(5,'a'), (3,'b')]) == 'a'+findWithDefault :: Ord k => a -> k -> IntervalMap k a -> a+findWithDefault def k m = def `seq` case M.lookup k m of+ Nothing -> def+ Just x -> x++-- | /O(n)/. Build a map from an ascending list in linear time.+-- /The precondition (input list is ascending) is not checked./+fromAscList :: (Interval k e, Eq k) => [(k,v)] -> IntervalMap k v+fromAscList xs = fromAscListWith (\_ b -> b) xs++-- | /O(n)/. Build a map from an ascending list in linear time with a combining function for equal keys.+-- /The precondition (input list is ascending) is not checked./+fromAscListWith :: (Interval k e, Eq k) => (a -> a -> a) -> [(k,a)] -> IntervalMap k a +fromAscListWith f xs = fromAscListWithKey (\_ a b -> f a b) xs++-- | /O(n)/. Build a map from an ascending list in linear time with a combining function for equal keys.+-- /The precondition (input list is ascending) is not checked./+fromAscListWithKey :: (Interval k e, Eq k) => (k -> a -> a -> a) -> [(k,a)] -> IntervalMap k a+fromAscListWithKey f xs = fromDistinctAscList (combineEq f xs)++combineEq :: Eq k => (k -> a -> a -> a) -> [(k,a)] -> [(k,a)]+combineEq _ [] = []+combineEq _ xs@[_] = xs+combineEq f (x@(xk,xv) : xs@((yk,yv) : xs'))+ | xk == yk = let v' = f xk xv yv in v' `seq` combineEq f ((xk, v') : xs')+ | otherwise = x : combineEq f xs+
+ bench/RBColorNodeBase.hs view
@@ -0,0 +1,453 @@+-- Version of IntervalMap where Color is embedded in Node constructor.+-- Only lookup and fromDistinctAscList are supported+--+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE FlexibleContexts #-}+module RBColorNodeBase (+ -- * re-export+ Interval(..)+ -- * Map type+ , IntervalMap(..) -- instance Eq,Show,Read++ -- * Operators+ , (!)++ -- * Query+ , null+ , size+ , member+ , notMember+ , lookup+ , findWithDefault++ -- ** Interval query+ , containing+ , intersecting+ , within+ + -- * Construction+ , empty+ , singleton++ -- * Conversion+ , elems+ , keys+ , keysSet+ , assocs++ -- ** Lists+ , toList++ -- ** Ordered lists+ , toAscList+ , toDescList+ , fromAscList+ , fromAscListWith+ , fromAscListWithKey+ , fromDistinctAscList++ -- * Internal, not re-exported by Data.IntervalMap.{Lazy,Strict}+ , turnBlack++ -- * Testing+ , height, maxHeight, showStats++ ) where++import Prelude hiding (null, lookup, map, filter, foldr, foldl)+import Data.Bits (shiftR, (.&.))+import Data.Monoid (Monoid(..))+import Control.Applicative (Applicative(..), (<$>))+import Data.Traversable (Traversable(traverse))+import qualified Data.Foldable as Foldable+import qualified Data.List as L+import qualified Data.Set as Set+import Control.DeepSeq++import Data.IntervalMap.Generic.Interval++{--------------------------------------------------------------------+ Operators+--------------------------------------------------------------------}+infixl 9 !++-- | /O(log n)/. Lookup value for given key. Calls 'error' if the key is not in the map.+--+-- Use 'lookup' or 'findWithDefault' instead of this function, unless you are absolutely+-- sure that the key is present in the map.+(!) :: (Interval k e, Ord k) => IntervalMap k v -> k -> v+tree ! key = case lookup key tree of+ Just v -> v+ Nothing -> error "IntervalMap.!: key not found"+++-- | A map from intervals of type @k@ to values of type @v@.+data IntervalMap k v = Nil+ | NodeR+ !k -- key+ !k -- interval with maximum upper in tree+ v -- value+ !(IntervalMap k v) -- left subtree+ !(IntervalMap k v) -- right subtree+ | NodeB+ !k -- key+ !k -- interval with maximum upper in tree+ v -- value+ !(IntervalMap k v) -- left subtree+ !(IntervalMap k v) -- right subtree++instance (Eq k, Eq v) => Eq (IntervalMap k v) where+ a == b = toAscList a == toAscList b++instance (Ord k, Ord v) => Ord (IntervalMap k v) where+ compare a b = compare (toAscList a) (toAscList b)++instance Functor (IntervalMap k) where+ fmap f m = map f m++instance Traversable (IntervalMap k) where+ traverse _ Nil = pure Nil+ traverse f (NodeR k m v l r) = flip (NodeR k m) <$> traverse f l <*> f v <*> traverse f r+ traverse f (NodeB k m v l r) = flip (NodeB k m) <$> traverse f l <*> f v <*> traverse f r++instance Foldable.Foldable (IntervalMap k) where+ fold Nil = mempty+ fold (NodeR _ _ v l r) = Foldable.fold l `mappend` v `mappend` Foldable.fold r+ fold (NodeB _ _ v l r) = Foldable.fold l `mappend` v `mappend` Foldable.fold r+ foldr = foldr+ foldl = foldl+ foldMap _ Nil = mempty+ foldMap f (NodeR _ _ v l r) = Foldable.foldMap f l `mappend` f v `mappend` Foldable.foldMap f r+ foldMap f (NodeB _ _ v l r) = Foldable.foldMap f l `mappend` f v `mappend` Foldable.foldMap f r++instance (NFData k, NFData a) => NFData (IntervalMap k a) where+ rnf Nil = ()+ rnf (NodeR kx _ x l r) = kx `deepseq` x `deepseq` l `deepseq` r `deepseq` ()+ rnf (NodeB kx _ x l r) = kx `deepseq` x `deepseq` l `deepseq` r `deepseq` ()++instance (Show k, Show a) => Show (IntervalMap k a) where+ showsPrec d m = showParen (d > 10) $+ showString "fromList " . shows (toList m)+++isRed :: IntervalMap k v -> Bool+isRed (NodeR _ _ _ _ _) = True+isRed _ = False++turnBlack :: IntervalMap k v -> IntervalMap k v+turnBlack (NodeR k m vs l r) = NodeB k m vs l r+turnBlack t = t++turnRed :: IntervalMap k v -> IntervalMap k v+turnRed Nil = error "turnRed: Leaf"+turnRed (NodeB k m v l r) = NodeR k m v l r+turnRed t = t++data Color = Red | Black+ +-- construct node, recomputing the upper key bound.+mNode :: (Interval k e) => Color -> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v+mNode Red k v l r = NodeR k (maxUpper k l r) v l r+mNode Black k v l r = NodeB k (maxUpper k l r) v l r++maxUpper :: (Interval i k) => i -> IntervalMap i v -> IntervalMap i v -> i+maxUpper k Nil Nil = k `seq` k+maxUpper k Nil (NodeR _ m _ _ _) = maxByUpper k m+maxUpper k Nil (NodeB _ m _ _ _) = maxByUpper k m+maxUpper k (NodeR _ m _ _ _) Nil = maxByUpper k m+maxUpper k (NodeR _ l _ _ _) (NodeR _ r _ _ _) = maxByUpper k (maxByUpper l r)+maxUpper k (NodeR _ l _ _ _) (NodeB _ r _ _ _) = maxByUpper k (maxByUpper l r)+maxUpper k (NodeB _ m _ _ _) Nil = maxByUpper k m+maxUpper k (NodeB _ l _ _ _) (NodeR _ r _ _ _) = maxByUpper k (maxByUpper l r)+maxUpper k (NodeB _ l _ _ _) (NodeB _ r _ _ _) = maxByUpper k (maxByUpper l r)++-- interval with the greatest upper bound. The lower bound is ignored!+maxByUpper :: (Interval i e) => i -> i -> i+maxByUpper a b | rightClosed a = if upperBound a >= upperBound b then a else b+ | otherwise = if upperBound a > upperBound b then a else b++-- ---------------------------------------------------------++-- | /O(1)/. The empty map.+empty :: IntervalMap k v+empty = Nil++-- | /O(1)/. A map with one entry.+singleton :: k -> v -> IntervalMap k v+singleton k v = NodeB k k v Nil Nil+++-- | /O(1)/. Is the map empty?+null :: IntervalMap k v -> Bool+null Nil = True+null _ = False++-- | /O(n)/. Number of keys in the map.+--+-- Caution: unlike 'Data.Map.size', which takes constant time, this is linear in the+-- number of keys!+size :: IntervalMap k v -> Int+size t = h 0 t+ where+ h n m = n `seq` case m of+ Nil -> n+ NodeR _ _ _ l r -> h (h n l + 1) r+ NodeB _ _ _ l r -> h (h n l + 1) r++-- | The height of the tree. For testing/debugging only.+height :: IntervalMap k v -> Int+height Nil = 0+height (NodeR _ _ _ l r) = 1 + max (height l) (height r)+height (NodeB _ _ _ l r) = 1 + max (height l) (height r)++-- | The maximum height of a red-black tree with the given number of nodes.+-- For testing/debugging only.+maxHeight :: Int -> Int+maxHeight nodes = 2 * log2 (nodes + 1)++-- | Tree statistics (size, height, maxHeight size).+-- For testing/debugging only.+showStats :: IntervalMap k a -> (Int, Int, Int)+showStats m = (n, height m, maxHeight n)+ where n = size m++-- | /O(log n)/. Does the map contain the given key? See also 'notMember'.+member :: (Ord k) => k -> IntervalMap k v -> Bool+member key tree = case lookup key tree of+ Nothing -> False+ Just _ -> True++-- | /O(log n)/. Does the map not contain the given key? See also 'member'.+notMember :: (Ord k) => k -> IntervalMap k v -> Bool+notMember key tree = not (member key tree)+++-- | /O(log n)/. Look up the given key in the map, returning the value @('Just' value)@,+-- or 'Nothing' if the key is not in the map.+lookup :: (Ord k) => k -> IntervalMap k v -> Maybe v+lookup k Nil = k `seq` Nothing+lookup k (NodeR key _ v l r) = case compare k key of+ LT -> lookup k l+ GT -> lookup k r+ EQ -> Just v+lookup k (NodeB key _ v l r) = case compare k key of+ LT -> lookup k l+ GT -> lookup k r+ EQ -> Just v+++-- | /O(log n)/. The expression @('findWithDefault' def k map)@ returns+-- the value at key @k@ or returns default value @def@+-- when the key is not in the map.+findWithDefault :: Ord k => a -> k -> IntervalMap k a -> a+findWithDefault def k m = case lookup k m of+ Nothing -> def+ Just x -> x++-- | Return all key/value pairs where the key intervals contain the given point.+-- The elements are returned in ascending key order.+--+-- /O(n)/, since potentially all keys could contain the point.+-- /O(log n)/ average case. This is also the worst case for maps containing no overlapping keys.+containing :: (Interval k e) => IntervalMap k v -> e -> [(k, v)]+t `containing` pt = go [] pt t+ where+ go xs p Nil = p `seq` xs+ go xs p (NodeR k m v l r)+ | p `above` m = xs -- above all intervals in the tree: no result+ | p `below` k = go xs p l -- to the left of the lower bound: can't be in right subtree+ | p `inside` k = go ((k,v) : go xs p r) p l+ | otherwise = go (go xs p r) p l+ go xs p (NodeB k m v l r)+ | p `above` m = xs -- above all intervals in the tree: no result+ | p `below` k = go xs p l -- to the left of the lower bound: can't be in right subtree+ | p `inside` k = go ((k,v) : go xs p r) p l+ | otherwise = go (go xs p r) p l++-- | Return all key/value pairs where the key intervals overlap (intersect) the given interval.+-- The elements are returned in ascending key order.+--+-- /O(n)/, since potentially all keys could intersect the interval.+-- /O(log n)/ average case, if few keys intersect the interval.+intersecting :: (Interval k e) => IntervalMap k v -> k -> [(k, v)]+t `intersecting` iv = go [] iv t+ where+ go xs i Nil = i `seq` xs+ go xs i (NodeR k m v l r)+ | i `after` m = xs+ | i `before` k = go xs i l+ | i `overlaps` k = go ((k,v) : go xs i r) i l+ | otherwise = go (go xs i r) i l+ go xs i (NodeB k m v l r)+ | i `after` m = xs+ | i `before` k = go xs i l+ | i `overlaps` k = go ((k,v) : go xs i r) i l+ | otherwise = go (go xs i r) i l++-- | Return all key/value pairs where the key intervals are completely inside the given interval.+-- The elements are returned in ascending key order.+--+-- /O(n)/, since potentially all keys could be inside the interval.+-- /O(log n)/ average case, if few keys are inside the interval.+within :: (Interval k e) => IntervalMap k v -> k -> [(k, v)]+t `within` iv = go [] iv t+ where+ go xs i Nil = i `seq` xs+ go xs i (NodeR k m v l r)+ | i `after` m = xs+ | i `before` k = go xs i l+ | i `subsumes` k = go ((k,v) : go xs i r) i l+ | otherwise = go (go xs i r) i l+ go xs i (NodeB k m v l r)+ | i `after` m = xs+ | i `before` k = go xs i l+ | i `subsumes` k = go ((k,v) : go xs i r) i l+ | otherwise = go (go xs i r) i l++-- | /O(n)/. Fold the values in the map using the given right-associative+-- binary operator, such that @'foldr' f z == 'Prelude.foldr' f z . 'elems'@.+foldr :: (a -> b -> b) -> b -> IntervalMap k a -> b+foldr _ z Nil = z+foldr f z (NodeR _ _ x l r) = foldr f (f x (foldr f z r)) l+foldr f z (NodeB _ _ x l r) = foldr f (f x (foldr f z r)) l++-- | /O(n)/. Fold the values in the map using the given left-associative+-- binary operator, such that @'foldl' f z == 'Prelude.foldl' f z . 'elems'@.+foldl :: (b -> a -> b) -> b -> IntervalMap k a -> b+foldl _ z Nil = z+foldl f z (NodeR _ _ x l r) = foldl f (f (foldl f z l) x) r+foldl f z (NodeB _ _ x l r) = foldl f (f (foldl f z l) x) r++-- | /O(n)/. Fold the keys and values in the map using the given right-associative+-- binary operator, such that+-- @'foldrWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@.+foldrWithKey :: (k -> v -> a -> a) -> a -> IntervalMap k v -> a+foldrWithKey _ z Nil = z+foldrWithKey f z (NodeR k _ x l r) = foldrWithKey f (f k x (foldrWithKey f z r)) l+foldrWithKey f z (NodeB k _ x l r) = foldrWithKey f (f k x (foldrWithKey f z r)) l++-- | /O(n)/. Fold the keys and values in the map using the given left-associative+-- binary operator, such that+-- @'foldlWithKey' f z == 'Prelude.foldl' (\\z' (kx, x) -> f z' kx x) z . 'toAscList'@.+foldlWithKey :: (a -> k -> v -> a) -> a -> IntervalMap k v -> a+foldlWithKey _ z Nil = z+foldlWithKey f z (NodeR k _ x l r) = foldlWithKey f (f (foldlWithKey f z l) k x) r+foldlWithKey f z (NodeB k _ x l r) = foldlWithKey f (f (foldlWithKey f z l) k x) r++-- | /O(n)/. Map a function over all values in the map.+map :: (a -> b) -> IntervalMap k a -> IntervalMap k b+map f = mapWithKey (\_ x -> f x)++-- | /O(n)/. Map a function over all values in the map.+mapWithKey :: (k -> a -> b) -> IntervalMap k a -> IntervalMap k b+mapWithKey f = go+ where+ go Nil = Nil+ go (NodeR k m v l r) = NodeR k m (f k v) (go l) (go r)+ go (NodeB k m v l r) = NodeB k m (f k v) (go l) (go r)++-- --- Conversion ---++-- | /O(n)/. The list of all key\/value pairs contained in the map, in ascending order of keys.+toAscList :: IntervalMap k v -> [(k,v)]+toAscList m = foldrWithKey (\k v r -> (k,v) : r) [] m++-- | /O(n)/. The list of all key\/value pairs contained in the map, in no particular order.+toList :: IntervalMap k v -> [(k,v)]+toList m = toAscList m++-- | /O(n)/. The list of all key\/value pairs contained in the map, in descending order of keys.+toDescList :: IntervalMap k v -> [(k, v)]+toDescList m = foldlWithKey (\r k v -> (k,v) : r) [] m++-- | /O(n)/. Build a map from an ascending list in linear time.+-- /The precondition (input list is ascending) is not checked./+fromAscList :: (Interval k e, Eq k) => [(k,v)] -> IntervalMap k v+fromAscList xs = fromAscListWith (\_ b -> b) xs++-- | /O(n)/. Build a map from an ascending list in linear time with a combining function for equal keys.+-- /The precondition (input list is ascending) is not checked./+fromAscListWith :: (Interval k e, Eq k) => (a -> a -> a) -> [(k,a)] -> IntervalMap k a +fromAscListWith f xs = fromAscListWithKey (\_ a b -> f a b) xs++-- | /O(n)/. Build a map from an ascending list in linear time with a combining function for equal keys.+-- /The precondition (input list is ascending) is not checked./+fromAscListWithKey :: (Interval k e, Eq k) => (k -> a -> a -> a) -> [(k,a)] -> IntervalMap k a +fromAscListWithKey f xs = fromDistinctAscList (combineEq f xs)++combineEq :: Eq k => (k -> a -> a -> a) -> [(k,a)] -> [(k,a)]+combineEq _ [] = []+combineEq _ xs@[_] = xs+combineEq f (x@(xk,xv) : xs@((yk,yv) : xs'))+ | xk == yk = combineEq f ((xk, f xk xv yv) : xs')+ | otherwise = x : combineEq f xs+++-- Strict tuple+data T2 a b = T2 !a !b+++-- | /O(n)/. Build a map from an ascending list of elements with distinct keys in linear time.+-- /The precondition is not checked./+fromDistinctAscList :: (Interval k e) => [(k,v)] -> IntervalMap k v+-- exactly 2^n-1 items have height n. They can be all black+-- from 2^n - 2^n-2 items have height n+1. The lowest "row" should be red.+fromDistinctAscList lyst = case h (length lyst) lyst of+ (T2 result []) -> result+ _ -> error "fromDistinctAscList: list not fully consumed"+ where+ h n xs | n == 0 = T2 Nil xs+ | isPerfect n = buildB n xs+ | otherwise = buildR n (log2 n) xs++ buildB n xs | xs `seq` n <= 0 = error "fromDictinctAscList: buildB 0"+ | n == 1 = case xs of ((k,v):xs') -> T2 (NodeB k k v Nil Nil) xs'+ _ -> error "fromDictinctAscList: buildB 1"+ | otherwise =+ case n `quot` 2 of { n' ->+ case buildB n' xs of { (T2 _ []) -> error "fromDictinctAscList: buildB n";+ (T2 l ((k,v):xs')) ->+ case buildB n' xs' of { (T2 r xs'') ->+ T2 (mNode Black k v l r) xs'' }}}++ buildR n d xs | d `seq` xs `seq` n == 0 = T2 Nil xs+ | n == 1 = case xs of ((k,v):xs') -> T2 (if d == 0 then NodeR k k v Nil Nil+ else NodeB k k v Nil Nil)+ xs'+ _ -> error "fromDistinctAscList: buildR 1"+ | otherwise =+ case n `quot` 2 of { n' ->+ case buildR n' (d-1) xs of { (T2 _ []) -> error "fromDistinctAscList: buildR n";+ (T2 l ((k,v):xs')) ->+ case buildR (n - (n' + 1)) (d-1) xs' of { (T2 r xs'') ->+ T2 (mNode Black k v l r) xs'' }}}+++-- is n a perfect binary tree size (2^m-1)?+isPerfect :: Int -> Bool+isPerfect n = (n .&. (n + 1)) == 0++log2 :: Int -> Int+log2 m = h (-1) m+ where+ h r n | r `seq` n <= 0 = r+ | otherwise = h (r + 1) (n `shiftR` 1)+++-- | /O(n)/. List of all values in the map, in ascending order of their keys.+elems :: IntervalMap k v -> [v]+elems m = [v | (_,v) <- toAscList m]++-- | /O(n)/. List of all keys in the map, in ascending order.+keys :: IntervalMap k v -> [k]+keys m = [k | (k,_) <- toAscList m]++-- | /O(n)/. Set of the keys.+keysSet :: (Ord k) => IntervalMap k v -> Set.Set k+keysSet m = Set.fromDistinctAscList (keys m)++-- | Same as 'toAscList'.+assocs :: IntervalMap k v -> [(k, v)]+assocs m = toAscList m+
changelog view
@@ -1,3 +1,5 @@+0.4.1.1 Fix bug in benchmark.+ 0.4.1.0 Add IntervalSet. Minor performance tweaks. Documentation updates.