Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Comparing changes

Choose two branches to see what's changed or to start a new pull request. If you need to, you can also compare across forks.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also compare across forks.
...
Checking mergeability… Don't worry, you can still create the pull request.
  • 16 commits
  • 12 files changed
  • 0 commit comments
  • 1 contributor
Commits on Mar 04, 2012
@foxik foxik Int{Set.Map}.delete{Min,Max} doesn't fail on empty.
Make Int{Map,Set}.delete{Min,Max} behave like {Map,Set}.delete{Min,Max}.
* Old behaviour: Int{Set,Map}.delete{Min,Max} empty ==> error
* New behaviour: Int{Set,Map}.delete{Min,Max} empty ==  empty
f461aea
@foxik foxik Unify IntMap.deleteFind{Min,Max} with the Map ...
... counterparts.

The type signature has changed from
  IntMap.deleteFind{Min,Max} :: IntMap a -> (a, IntMap a)
to
  IntMap.deleteFind{Min,Max} :: IntMap a -> ((Key, a), IntMap a)
.
0bead51
@foxik foxik Generalize IntMap.update{Min,Max}[WithKey].
Previously these methods were given an argument of type
  [Key ->] a -> a
Now they are given an argument of type
  [Key ->] a -> Maybe a
That makes them compatible with Map counterparts.
4c0a002
@foxik foxik Remove unnecessary methods from Data.Map.Strict.
Remove implementations of mapKeys and mapKeysMonotonic
from Data.Map.Strict module. These methods modify keys only
and even Data.Map.Lazy are strict in keys.
b53359b
@foxik foxik Improve performance of Map.mapKeys[With].
We can manually fuse
  List.map fFirst . toList
    where fFirst (a, b) = (f a, b)
using the right fold as
  foldrWithKey (\k x xs -> (f k, x) : xs) []
7afa9c0
@foxik foxik Add IntMap.mapKeys* methods.
Add IntMap.mapKeys, mapKeysWith, mapKeysMonotonic.
These functions are present in the Map module and we want IntMap
to be a replacement of Map Int.

The IntMap.mapKeysMonotonic is not as efficient as Map.mapKeysMonotonic
because of the IntMap representation -- the trie structure changes
wildly when the keys changes, even if the ordering of keys is not
altered.

Also, some time complexities were corrected.
4ee54fe
@foxik foxik Improve tests.
* Test IntMap.mapKeys, mapKeysWith, mapKeysMonotonic, which were just
  added.

* Unify map-properties and intmap-properties as possible, by renaming
  methods and changing comments, so that they are the same in both.
eaa4d34
@foxik foxik Improve formatting of oneliners. 079c641
@foxik foxik Add toDescList.
Add toDescList to IntMap, Set and IntSet. Also add
corresponding fusion RULES and tests.

The function is added as community was opposed to removing
toDescList from Map.
69ae239
@foxik foxik Improve {Map,IntMap}.intersection* and its tests.
* Add tests for intersectionWith*.
* Add specific Map.intersection implementation instead of using
  Map.intersectionWithKey.
* Refactor Map.intersectionWithKey implementatioin.
0aaac52
@foxik foxik Improve IntMap.fold*.
Improve IntMap.fold* not to do two checks for negative numbers
-- both prefix and mask were tested. Mask tests are enough.
5d742ef
@foxik foxik Improve Int{Map,Set}.fold*.
Improve Int{Map,Set}.fold* defitions to be inlinable with
two arguments only.

Otherwise GHC inlined toAscList, toDescList _and after that_ inlined
the fold, resulting in useless code growth.
c0e28dc
@foxik foxik Improve Int{Set,Map}.fold*.
In the fold definitions, do not call go if the Bin constructor was
matched during the test for negative numbers. Instead, manually inline
that branch of go.

Otherwise GHC optimizer does this for us -- it creates local definition
of that branch of go and calls it. On my machine, it causes >200B growth
of object file, for every fold.
a7d02d5
@foxik foxik Improve list fusion.
* Allow fusable methods to be converted back to the original call when
  no fusion happens. For that, foldlFB and foldrFB are used, inspired by
  mapFB from Prelude.

* Remove RULES for aliases like toList, assocs, elems, just INLINE them.
0c5e71c
@foxik foxik Fix Data.Sequence warnings.
As GHC HEAD found out, methods deep, node2, node3 were both
INLINE and SPECIALIZE. Make them INLINE only.

Also the -Wwarn option can be removed.
68cc2e8
@foxik foxik Improve {Map,IntMap}.fold* tests. 67b4a05
View
245 Data/IntMap/Base.hs
@@ -84,6 +84,9 @@ module Data.IntMap.Base (
, mapAccum
, mapAccumWithKey
, mapAccumRWithKey
+ , mapKeys
+ , mapKeysWith
+ , mapKeysMonotonic
-- * Folds
, foldr
@@ -110,6 +113,7 @@ module Data.IntMap.Base (
-- ** Ordered lists
, toAscList
+ , toDescList
, fromAscList
, fromAscListWith
, fromAscListWithKey
@@ -347,7 +351,7 @@ member k m
Nothing -> False
Just _ -> True
--- | /O(log n)/. Is the key not a member of the map?
+-- | /O(min(n,W))/. Is the key not a member of the map?
--
-- > notMember 5 (fromList [(5,'a'), (3,'b')]) == False
-- > notMember 1 (fromList [(5,'a'), (3,'b')]) == True
@@ -610,7 +614,7 @@ updateLookupWithKey f k t = k `seq`
--- | /O(log n)/. The expression (@'alter' f k map@) alters the value @x@ at @k@, or absence thereof.
+-- | /O(min(n,W))/. The expression (@'alter' f k map@) alters the value @x@ at @k@, or absence thereof.
-- 'alter' can be used to insert, delete, or update a value in an 'IntMap'.
-- In short : @'lookup' k ('alter' f k m) = f ('lookup' k m)@.
alter :: (Maybe a -> Maybe a) -> Key -> IntMap a -> IntMap a
@@ -868,33 +872,39 @@ intersectionWithKey _ _ Nil = Nil
Min\/Max
--------------------------------------------------------------------}
--- | /O(log n)/. Update the value at the minimal key.
+-- | /O(min(n,W))/. Update the value at the minimal key.
--
--- > updateMinWithKey (\ k a -> (show k) ++ ":" ++ a) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"3:b"), (5,"a")]
+-- > updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"3:b"), (5,"a")]
+-- > updateMinWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
-updateMinWithKey :: (Key -> a -> a) -> IntMap a -> IntMap a
+updateMinWithKey :: (Key -> a -> Maybe a) -> IntMap a -> IntMap a
updateMinWithKey f t =
- case t of Bin p m l r | m < 0 -> Bin p m l (go f r)
+ case t of Bin p m l r | m < 0 -> bin p m l (go f r)
_ -> go f t
where
- go f' (Bin p m l r) = Bin p m (go f' l) r
- go f' (Tip k y) = Tip k (f' k y)
+ go f' (Bin p m l r) = bin p m (go f' l) r
+ go f' (Tip k y) = case f' k y of
+ Just y' -> Tip k y'
+ Nothing -> Nil
go _ Nil = error "updateMinWithKey Nil"
--- | /O(log n)/. Update the value at the maximal key.
+-- | /O(min(n,W))/. Update the value at the maximal key.
--
--- > updateMaxWithKey (\ k a -> (show k) ++ ":" ++ a) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"b"), (5,"5:a")]
+-- > updateMaxWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"b"), (5,"5:a")]
+-- > updateMaxWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
-updateMaxWithKey :: (Key -> a -> a) -> IntMap a -> IntMap a
+updateMaxWithKey :: (Key -> a -> Maybe a) -> IntMap a -> IntMap a
updateMaxWithKey f t =
- case t of Bin p m l r | m < 0 -> Bin p m (go f l) r
+ case t of Bin p m l r | m < 0 -> bin p m (go f l) r
_ -> go f t
where
- go f' (Bin p m l r) = Bin p m l (go f' r)
- go f' (Tip k y) = Tip k (f' k y)
+ go f' (Bin p m l r) = bin p m l (go f' r)
+ go f' (Tip k y) = case f' k y of
+ Just y' -> Tip k y'
+ Nothing -> Nil
go _ Nil = error "updateMaxWithKey Nil"
--- | /O(log n)/. Retrieves the maximal (key,value) pair of the map, and
+-- | /O(min(n,W))/. Retrieves the maximal (key,value) pair of the map, and
-- the map stripped of that element, or 'Nothing' if passed an empty map.
--
-- > maxViewWithKey (fromList [(5,"a"), (3,"b")]) == Just ((5,"a"), singleton 3 "b")
@@ -910,7 +920,7 @@ maxViewWithKey t =
go (Tip k y) = ((k, y), Nil)
go Nil = error "maxViewWithKey Nil"
--- | /O(log n)/. Retrieves the minimal (key,value) pair of the map, and
+-- | /O(min(n,W))/. Retrieves the minimal (key,value) pair of the map, and
-- the map stripped of that element, or 'Nothing' if passed an empty map.
--
-- > minViewWithKey (fromList [(5,"a"), (3,"b")]) == Just ((3,"b"), singleton 5 "a")
@@ -926,43 +936,45 @@ minViewWithKey t =
go (Tip k y) = ((k, y), Nil)
go Nil = error "minViewWithKey Nil"
--- | /O(log n)/. Update the value at the maximal key.
+-- | /O(min(n,W))/. Update the value at the maximal key.
--
--- > updateMax (\ a -> "X" ++ a) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "Xa")]
+-- > updateMax (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "Xa")]
+-- > updateMax (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
-updateMax :: (a -> a) -> IntMap a -> IntMap a
+updateMax :: (a -> Maybe a) -> IntMap a -> IntMap a
updateMax f = updateMaxWithKey (const f)
--- | /O(log n)/. Update the value at the minimal key.
+-- | /O(min(n,W))/. Update the value at the minimal key.
--
--- > updateMin (\ a -> "X" ++ a) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "Xb"), (5, "a")]
+-- > updateMin (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "Xb"), (5, "a")]
+-- > updateMin (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
-updateMin :: (a -> a) -> IntMap a -> IntMap a
+updateMin :: (a -> Maybe a) -> IntMap a -> IntMap a
updateMin f = updateMinWithKey (const f)
-- Similar to the Arrow instance.
first :: (a -> c) -> (a, b) -> (c, b)
first f (x,y) = (f x,y)
--- | /O(log n)/. Retrieves the maximal key of the map, and the map
+-- | /O(min(n,W))/. Retrieves the maximal key of the map, and the map
-- stripped of that element, or 'Nothing' if passed an empty map.
maxView :: IntMap a -> Maybe (a, IntMap a)
maxView t = liftM (first snd) (maxViewWithKey t)
--- | /O(log n)/. Retrieves the minimal key of the map, and the map
+-- | /O(min(n,W))/. Retrieves the minimal key of the map, and the map
-- stripped of that element, or 'Nothing' if passed an empty map.
minView :: IntMap a -> Maybe (a, IntMap a)
minView t = liftM (first snd) (minViewWithKey t)
--- | /O(log n)/. Delete and find the maximal element.
-deleteFindMax :: IntMap a -> (a, IntMap a)
-deleteFindMax = fromMaybe (error "deleteFindMax: empty map has no maximal element") . maxView
+-- | /O(min(n,W))/. Delete and find the maximal element.
+deleteFindMax :: IntMap a -> ((Key, a), IntMap a)
+deleteFindMax = fromMaybe (error "deleteFindMax: empty map has no maximal element") . maxViewWithKey
--- | /O(log n)/. Delete and find the minimal element.
-deleteFindMin :: IntMap a -> (a, IntMap a)
-deleteFindMin = fromMaybe (error "deleteFindMin: empty map has no minimal element") . minView
+-- | /O(min(n,W))/. Delete and find the minimal element.
+deleteFindMin :: IntMap a -> ((Key, a), IntMap a)
+deleteFindMin = fromMaybe (error "deleteFindMin: empty map has no minimal element") . minViewWithKey
--- | /O(log n)/. The minimal key of the map.
+-- | /O(min(n,W))/. The minimal key of the map.
findMin :: IntMap a -> (Key, a)
findMin Nil = error $ "findMin: empty map has no minimal element"
findMin (Tip k v) = (k,v)
@@ -973,7 +985,7 @@ findMin (Bin _ m l r)
go (Bin _ _ l' _) = go l'
go Nil = error "findMax Nil"
--- | /O(log n)/. The maximal key of the map.
+-- | /O(min(n,W))/. The maximal key of the map.
findMax :: IntMap a -> (Key, a)
findMax Nil = error $ "findMax: empty map has no maximal element"
findMax (Tip k v) = (k,v)
@@ -984,15 +996,15 @@ findMax (Bin _ m l r)
go (Bin _ _ _ r') = go r'
go Nil = error "findMax Nil"
--- | /O(log n)/. Delete the minimal key. An error is thrown if the IntMap is already empty.
+-- | /O(min(n,W))/. Delete the minimal key. An error is thrown if the IntMap is already empty.
-- Note, this is not the same behavior Map.
deleteMin :: IntMap a -> IntMap a
-deleteMin = maybe (error "deleteMin: empty map has no minimal element") snd . minView
+deleteMin = maybe Nil snd . minView
--- | /O(log n)/. Delete the maximal key. An error is thrown if the IntMap is already empty.
+-- | /O(min(n,W))/. Delete the maximal key. An error is thrown if the IntMap is already empty.
-- Note, this is not the same behavior Map.
deleteMax :: IntMap a -> IntMap a
-deleteMax = maybe (error "deleteMax: empty map has no maximal element") snd . maxView
+deleteMax = maybe Nil snd . maxView
{--------------------------------------------------------------------
@@ -1150,6 +1162,52 @@ mapAccumRWithKey f a t
Tip k x -> let (a',x') = f a k x in (a',Tip k x')
Nil -> (a,Nil)
+-- | /O(n*min(n,W))/.
+-- @'mapKeys' f s@ is the map obtained by applying @f@ to each key of @s@.
+--
+-- The size of the result may be smaller if @f@ maps two or more distinct
+-- keys to the same new key. In this case the value at the greatest of the
+-- original keys is retained.
+--
+-- > mapKeys (+ 1) (fromList [(5,"a"), (3,"b")]) == fromList [(4, "b"), (6, "a")]
+-- > mapKeys (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 1 "c"
+-- > mapKeys (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 3 "c"
+
+mapKeys :: (Key->Key) -> IntMap a -> IntMap a
+mapKeys f = fromList . foldrWithKey (\k x xs -> (f k, x) : xs) []
+
+-- | /O(n*min(n,W))/.
+-- @'mapKeysWith' c f s@ is the map obtained by applying @f@ to each key of @s@.
+--
+-- The size of the result may be smaller if @f@ maps two or more distinct
+-- keys to the same new key. In this case the associated values will be
+-- combined using @c@.
+--
+-- > mapKeysWith (++) (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 1 "cdab"
+-- > mapKeysWith (++) (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 3 "cdab"
+
+mapKeysWith :: (a -> a -> a) -> (Key->Key) -> IntMap a -> IntMap a
+mapKeysWith c f = fromListWith c . foldrWithKey (\k x xs -> (f k, x) : xs) []
+
+-- | /O(n*min(n,W))/.
+-- @'mapKeysMonotonic' f s == 'mapKeys' f s@, but works only when @f@
+-- is strictly monotonic.
+-- That is, for any values @x@ and @y@, if @x@ < @y@ then @f x@ < @f y@.
+-- /The precondition is not checked./
+-- Semi-formally, we have:
+--
+-- > and [x < y ==> f x < f y | x <- ls, y <- ls]
+-- > ==> mapKeysMonotonic f s == mapKeys f s
+-- > where ls = keys s
+--
+-- This means that @f@ maps distinct original keys to distinct resulting keys.
+-- This function has slightly better performance than 'mapKeys'.
+--
+-- > mapKeysMonotonic (\ k -> k * 2) (fromList [(5,"a"), (3,"b")]) == fromList [(6, "b"), (10, "a")]
+
+mapKeysMonotonic :: (Key->Key) -> IntMap a -> IntMap a
+mapKeysMonotonic f = fromDistinctAscList . foldrWithKey (\k x xs -> (f k, x) : xs) []
+
{--------------------------------------------------------------------
Filter
--------------------------------------------------------------------}
@@ -1263,7 +1321,7 @@ mapEitherWithKey f (Tip k x) = case f k x of
Right z -> (Nil, Tip k z)
mapEitherWithKey _ Nil = (Nil, Nil)
--- | /O(log n)/. The expression (@'split' k map@) is a pair @(map1,map2)@
+-- | /O(min(n,W))/. The expression (@'split' k map@) is a pair @(map1,map2)@
-- where all keys in @map1@ are lower than @k@ and all keys in
-- @map2@ larger than @k@. Any key equal to @k@ is found in neither @map1@ nor @map2@.
--
@@ -1288,7 +1346,7 @@ split k t =
| otherwise = (Nil, Nil)
go _ Nil = (Nil, Nil)
--- | /O(log n)/. Performs a 'split' but also returns whether the pivot
+-- | /O(min(n,W))/. Performs a 'split' but also returns whether the pivot
-- key was found in the original map.
--
-- > splitLookup 2 (fromList [(5,"a"), (3,"b")]) == (empty, Nothing, fromList [(3,"b"), (5,"a")])
@@ -1325,9 +1383,10 @@ splitLookup k t =
-- > let f a len = len + (length a)
-- > foldr f 0 (fromList [(5,"a"), (3,"bbb")]) == 4
foldr :: (a -> b -> b) -> b -> IntMap a -> b
-foldr f z t =
- case t of Bin 0 m l r | m < 0 -> go (go z l) r -- put negative numbers before
- _ -> go z t
+foldr f z = \t -> -- Use lambda t to be inlinable with two arguments only.
+ case t of Bin _ m l r | m < 0 -> go (go z l) r -- put negative numbers before
+ | otherwise -> go (go z r) l
+ _ -> go z t
where
go z' Nil = z'
go z' (Tip _ x) = f x z'
@@ -1338,9 +1397,10 @@ foldr f z t =
-- evaluated before using the result in the next application. This
-- function is strict in the starting value.
foldr' :: (a -> b -> b) -> b -> IntMap a -> b
-foldr' f z t =
- case t of Bin 0 m l r | m < 0 -> go (go z l) r -- put negative numbers before
- _ -> go z t
+foldr' f z = \t -> -- Use lambda t to be inlinable with two arguments only.
+ case t of Bin _ m l r | m < 0 -> go (go z l) r -- put negative numbers before
+ | otherwise -> go (go z r) l
+ _ -> go z t
where
STRICT_1_OF_2(go)
go z' Nil = z'
@@ -1358,9 +1418,10 @@ foldr' f z t =
-- > let f len a = len + (length a)
-- > foldl f 0 (fromList [(5,"a"), (3,"bbb")]) == 4
foldl :: (a -> b -> a) -> a -> IntMap b -> a
-foldl f z t =
- case t of Bin 0 m l r | m < 0 -> go (go z r) l -- put negative numbers before
- _ -> go z t
+foldl f z = \t -> -- Use lambda t to be inlinable with two arguments only.
+ case t of Bin _ m l r | m < 0 -> go (go z r) l -- put negative numbers before
+ | otherwise -> go (go z l) r
+ _ -> go z t
where
go z' Nil = z'
go z' (Tip _ x) = f z' x
@@ -1371,9 +1432,10 @@ foldl f z t =
-- evaluated before using the result in the next application. This
-- function is strict in the starting value.
foldl' :: (a -> b -> a) -> a -> IntMap b -> a
-foldl' f z t =
- case t of Bin 0 m l r | m < 0 -> go (go z r) l -- put negative numbers before
- _ -> go z t
+foldl' f z = \t -> -- Use lambda t to be inlinable with two arguments only.
+ case t of Bin _ m l r | m < 0 -> go (go z r) l -- put negative numbers before
+ | otherwise -> go (go z l) r
+ _ -> go z t
where
STRICT_1_OF_2(go)
go z' Nil = z'
@@ -1392,9 +1454,10 @@ foldl' f z t =
-- > let f k a result = result ++ "(" ++ (show k) ++ ":" ++ a ++ ")"
-- > foldrWithKey f "Map: " (fromList [(5,"a"), (3,"b")]) == "Map: (5:a)(3:b)"
foldrWithKey :: (Int -> a -> b -> b) -> b -> IntMap a -> b
-foldrWithKey f z t =
- case t of Bin 0 m l r | m < 0 -> go (go z l) r -- put negative numbers before
- _ -> go z t
+foldrWithKey f z = \t -> -- Use lambda t to be inlinable with two arguments only.
+ case t of Bin _ m l r | m < 0 -> go (go z l) r -- put negative numbers before
+ | otherwise -> go (go z r) l
+ _ -> go z t
where
go z' Nil = z'
go z' (Tip kx x) = f kx x z'
@@ -1405,9 +1468,10 @@ foldrWithKey f z t =
-- evaluated before using the result in the next application. This
-- function is strict in the starting value.
foldrWithKey' :: (Int -> a -> b -> b) -> b -> IntMap a -> b
-foldrWithKey' f z t =
- case t of Bin 0 m l r | m < 0 -> go (go z l) r -- put negative numbers before
- _ -> go z t
+foldrWithKey' f z = \t -> -- Use lambda t to be inlinable with two arguments only.
+ case t of Bin _ m l r | m < 0 -> go (go z l) r -- put negative numbers before
+ | otherwise -> go (go z r) l
+ _ -> go z t
where
STRICT_1_OF_2(go)
go z' Nil = z'
@@ -1426,9 +1490,10 @@ foldrWithKey' f z t =
-- > let f result k a = result ++ "(" ++ (show k) ++ ":" ++ a ++ ")"
-- > foldlWithKey f "Map: " (fromList [(5,"a"), (3,"b")]) == "Map: (3:b)(5:a)"
foldlWithKey :: (a -> Int -> b -> a) -> a -> IntMap b -> a
-foldlWithKey f z t =
- case t of Bin 0 m l r | m < 0 -> go (go z r) l -- put negative numbers before
- _ -> go z t
+foldlWithKey f z = \t -> -- Use lambda t to be inlinable with two arguments only.
+ case t of Bin _ m l r | m < 0 -> go (go z r) l -- put negative numbers before
+ | otherwise -> go (go z l) r
+ _ -> go z t
where
go z' Nil = z'
go z' (Tip kx x) = f z' kx x
@@ -1439,9 +1504,10 @@ foldlWithKey f z t =
-- evaluated before using the result in the next application. This
-- function is strict in the starting value.
foldlWithKey' :: (a -> Int -> b -> a) -> a -> IntMap b -> a
-foldlWithKey' f z t =
- case t of Bin 0 m l r | m < 0 -> go (go z r) l -- put negative numbers before
- _ -> go z t
+foldlWithKey' f z = \t -> -- Use lambda t to be inlinable with two arguments only.
+ case t of Bin _ m l r | m < 0 -> go (go z r) l -- put negative numbers before
+ | otherwise -> go (go z l) r
+ _ -> go z t
where
STRICT_1_OF_2(go)
go z' Nil = z'
@@ -1487,8 +1553,7 @@ keysSet m = IntSet.fromDistinctAscList (keys m)
-- > assocs empty == []
assocs :: IntMap a -> [(Key,a)]
-assocs
- = toAscList
+assocs = toAscList
{--------------------------------------------------------------------
@@ -1501,8 +1566,7 @@ assocs
-- > toList empty == []
toList :: IntMap a -> [(Key,a)]
-toList
- = toAscList
+toList = toAscList
-- | /O(n)/. Convert the map to a list of key\/value pairs where the
-- keys are in ascending order. Subject to list fusion.
@@ -1510,16 +1574,49 @@ toList
-- > toAscList (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]
toAscList :: IntMap a -> [(Key,a)]
-toAscList
- = foldrWithKey (\k x xs -> (k,x):xs) []
+toAscList = foldrWithKey (\k x xs -> (k,x):xs) []
+
+-- | /O(n)/. Convert the map to a list of key\/value pairs where the keys
+-- are in descending order. Subject to list fusion.
+--
+-- > toDescList (fromList [(5,"a"), (3,"b")]) == [(5,"a"), (3,"b")]
+
+toDescList :: IntMap a -> [(Key,a)]
+toDescList = foldlWithKey (\xs k x -> (k,x):xs) []
+-- List fusion for the list generating functions.
#if __GLASGOW_HASKELL__
--- List fusion for the list generating functions
-{-# RULES "IntMap/elems" forall im . elems im = build (\c n -> foldr c n im) #-}
-{-# RULES "IntMap/keys" forall im . keys im = build (\c n -> foldrWithKey (\k _ ks -> c k ks) n im) #-}
-{-# RULES "IntMap/assocs" forall im . assocs im = build (\c n -> foldrWithKey (\k x xs -> c (k,x) xs) n im) #-}
-{-# RULES "IntMap/toList" forall im . toList im = build (\c n -> foldrWithKey (\k x xs -> c (k,x) xs) n im) #-}
-{-# RULES "IntMap/toAscList" forall im . toAscList im = build (\c n -> foldrWithKey (\k x xs -> c (k,x) xs) n im) #-}
+-- The foldrFB and foldlFB are fold{r,l}WithKey equivalents, used for list fusion.
+-- They are important to convert unfused methods back, see mapFB in prelude.
+foldrFB :: (Key -> a -> b -> b) -> b -> IntMap a -> b
+foldrFB = foldrWithKey
+{-# INLINE[0] foldrFB #-}
+foldlFB :: (a -> Key -> b -> a) -> a -> IntMap b -> a
+foldlFB = foldlWithKey
+{-# INLINE[0] foldlFB #-}
+
+-- Inline assocs and toList, so that we need to fuse only toAscList.
+{-# INLINE assocs #-}
+{-# INLINE toList #-}
+
+-- The fusion is enabled up to phase 2 included. If it does not succeed,
+-- convert in phase 1 the expanded elems,keys,to{Asc,Desc}List calls back to
+-- elems,keys,to{Asc,Desc}List. In phase 0, we inline fold{lr}FB (which were
+-- used in a list fusion, otherwise it would go away in phase 1), and let compiler
+-- do whatever it wants with elems,keys,to{Asc,Desc}List -- it was forbidden to
+-- inline it before phase 0, otherwise the fusion rules would not fire at all.
+{-# NOINLINE[0] elems #-}
+{-# NOINLINE[0] keys #-}
+{-# NOINLINE[0] toAscList #-}
+{-# NOINLINE[0] toDescList #-}
+{-# RULES "IntMap.elems" [~1] forall m . elems m = build (\c n -> foldrFB (\_ x xs -> c x xs) n m) #-}
+{-# RULES "IntMap.elemsBack" [1] foldrFB (\_ x xs -> x : xs) [] = elems #-}
+{-# RULES "IntMap.keys" [~1] forall m . keys m = build (\c n -> foldrFB (\k _ xs -> c k xs) n m) #-}
+{-# RULES "IntMap.keysBack" [1] foldrFB (\k _ xs -> k : xs) [] = keys #-}
+{-# RULES "IntMap.toAscList" [~1] forall m . toAscList m = build (\c n -> foldrFB (\k x xs -> c (k,x) xs) n m) #-}
+{-# RULES "IntMap.toAscListBack" [1] foldrFB (\k x xs -> (k, x) : xs) [] = toAscList #-}
+{-# RULES "IntMap.toDescList" [~1] forall m . toDescList m = build (\c n -> foldlFB (\xs k x -> c (k,x) xs) n m) #-}
+{-# RULES "IntMap.toDescListBack" [1] foldlFB (\xs k x -> (k, x) : xs) [] = toDescList #-}
#endif
View
4 Data/IntMap/Lazy.hs
@@ -116,6 +116,9 @@ module Data.IntMap.Lazy (
, mapAccum
, mapAccumWithKey
, mapAccumRWithKey
+ , mapKeys
+ , mapKeysWith
+ , mapKeysMonotonic
-- * Folds
, IM.foldr
@@ -142,6 +145,7 @@ module Data.IntMap.Lazy (
-- ** Ordered lists
, toAscList
+ , toDescList
, fromAscList
, fromAscListWith
, fromAscListWithKey
View
54 Data/IntMap/Strict.hs
@@ -120,6 +120,9 @@ module Data.IntMap.Strict (
, mapAccum
, mapAccumWithKey
, mapAccumRWithKey
+ , mapKeys
+ , mapKeysWith
+ , mapKeysMonotonic
-- * Folds
, foldr
@@ -146,6 +149,7 @@ module Data.IntMap.Strict (
-- ** Ordered lists
, toAscList
+ , toDescList
, fromAscList
, fromAscListWith
, fromAscListWithKey
@@ -221,6 +225,7 @@ import Data.IntMap.Base hiding
, mapAccum
, mapAccumWithKey
, mapAccumRWithKey
+ , mapKeysWith
, mapMaybe
, mapMaybeWithKey
, mapEither
@@ -634,42 +639,50 @@ intersectionWithKey _ _ Nil = Nil
-- | /O(log n)/. Update the value at the minimal key.
--
--- > updateMinWithKey (\ k a -> (show k) ++ ":" ++ a) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"3:b"), (5,"a")]
+-- > updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"3:b"), (5,"a")]
+-- > updateMinWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
-updateMinWithKey :: (Key -> a -> a) -> IntMap a -> IntMap a
+updateMinWithKey :: (Key -> a -> Maybe a) -> IntMap a -> IntMap a
updateMinWithKey f t =
- case t of Bin p m l r | m < 0 -> Bin p m l (go f r)
+ case t of Bin p m l r | m < 0 -> bin p m l (go f r)
_ -> go f t
where
- go f' (Bin p m l r) = Bin p m (go f' l) r
- go f' (Tip k y) = Tip k $! f' k y
+ go f' (Bin p m l r) = bin p m (go f' l) r
+ go f' (Tip k y) = case f' k y of
+ Just y' -> y' `seq` Tip k y'
+ Nothing -> Nil
go _ Nil = error "updateMinWithKey Nil"
-- | /O(log n)/. Update the value at the maximal key.
--
--- > updateMaxWithKey (\ k a -> (show k) ++ ":" ++ a) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"b"), (5,"5:a")]
+-- > updateMaxWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"b"), (5,"5:a")]
+-- > updateMaxWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
-updateMaxWithKey :: (Key -> a -> a) -> IntMap a -> IntMap a
+updateMaxWithKey :: (Key -> a -> Maybe a) -> IntMap a -> IntMap a
updateMaxWithKey f t =
- case t of Bin p m l r | m < 0 -> Bin p m (go f l) r
+ case t of Bin p m l r | m < 0 -> bin p m (go f l) r
_ -> go f t
where
- go f' (Bin p m l r) = Bin p m l (go f' r)
- go f' (Tip k y) = Tip k $! f' k y
+ go f' (Bin p m l r) = bin p m l (go f' r)
+ go f' (Tip k y) = case f' k y of
+ Just y' -> y' `seq` Tip k y'
+ Nothing -> Nil
go _ Nil = error "updateMaxWithKey Nil"
-- | /O(log n)/. Update the value at the maximal key.
--
--- > updateMax (\ a -> "X" ++ a) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "Xa")]
+-- > updateMax (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "Xa")]
+-- > updateMax (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
-updateMax :: (a -> a) -> IntMap a -> IntMap a
+updateMax :: (a -> Maybe a) -> IntMap a -> IntMap a
updateMax f = updateMaxWithKey (const f)
-- | /O(log n)/. Update the value at the minimal key.
--
--- > updateMin (\ a -> "X" ++ a) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "Xb"), (5, "a")]
+-- > updateMin (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "Xb"), (5, "a")]
+-- > updateMin (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
-updateMin :: (a -> a) -> IntMap a -> IntMap a
+updateMin :: (a -> Maybe a) -> IntMap a -> IntMap a
updateMin f = updateMinWithKey (const f)
@@ -738,6 +751,19 @@ mapAccumRWithKey f a t
Tip k x -> let (a',x') = f a k x in x' `seq` (a' `strictPair` Tip k x')
Nil -> (a `strictPair` Nil)
+-- | /O(n*log n)/.
+-- @'mapKeysWith' c f s@ is the map obtained by applying @f@ to each key of @s@.
+--
+-- The size of the result may be smaller if @f@ maps two or more distinct
+-- keys to the same new key. In this case the associated values will be
+-- combined using @c@.
+--
+-- > mapKeysWith (++) (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 1 "cdab"
+-- > mapKeysWith (++) (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 3 "cdab"
+
+mapKeysWith :: (a -> a -> a) -> (Key->Key) -> IntMap a -> IntMap a
+mapKeysWith c f = fromListWith c . foldrWithKey (\k x xs -> (f k, x) : xs) []
+
{--------------------------------------------------------------------
Filter
--------------------------------------------------------------------}
View
60 Data/IntSet.hs
@@ -125,6 +125,7 @@ module Data.IntSet (
-- ** Ordered list
, toAscList
+ , toDescList
, fromAscList
, fromDistinctAscList
@@ -675,11 +676,11 @@ findMax (Bin _ m l r)
-- | /O(min(n,W))/. Delete the minimal element.
deleteMin :: IntSet -> IntSet
-deleteMin = maybe (error "deleteMin: empty set has no minimal element") snd . minView
+deleteMin = maybe Nil snd . minView
-- | /O(min(n,W))/. Delete the maximal element.
deleteMax :: IntSet -> IntSet
-deleteMax = maybe (error "deleteMax: empty set has no maximal element") snd . maxView
+deleteMax = maybe Nil snd . maxView
{----------------------------------------------------------------------
Map
@@ -713,9 +714,10 @@ fold = foldr
--
-- > toAscList set = foldr (:) [] set
foldr :: (Int -> b -> b) -> b -> IntSet -> b
-foldr f z t =
+foldr f z = \t -> -- Use lambda t to be inlinable with two arguments only.
case t of Bin _ m l r | m < 0 -> go (go z l) r -- put negative numbers before
- _ -> go z t
+ | otherwise -> go (go z r) l
+ _ -> go z t
where
go z' Nil = z'
go z' (Tip kx bm) = foldrBits kx f z' bm
@@ -726,9 +728,10 @@ foldr f z t =
-- evaluated before using the result in the next application. This
-- function is strict in the starting value.
foldr' :: (Int -> b -> b) -> b -> IntSet -> b
-foldr' f z t =
+foldr' f z = \t -> -- Use lambda t to be inlinable with two arguments only.
case t of Bin _ m l r | m < 0 -> go (go z l) r -- put negative numbers before
- _ -> go z t
+ | otherwise -> go (go z r) l
+ _ -> go z t
where
STRICT_1_OF_2(go)
go z' Nil = z'
@@ -743,9 +746,10 @@ foldr' f z t =
--
-- > toDescList set = foldl (flip (:)) [] set
foldl :: (a -> Int -> a) -> a -> IntSet -> a
-foldl f z t =
+foldl f z = \t -> -- Use lambda t to be inlinable with two arguments only.
case t of Bin _ m l r | m < 0 -> go (go z r) l -- put negative numbers before
- _ -> go z t
+ | otherwise -> go (go z l) r
+ _ -> go z t
where
STRICT_1_OF_2(go)
go z' Nil = z'
@@ -757,9 +761,10 @@ foldl f z t =
-- evaluated before using the result in the next application. This
-- function is strict in the starting value.
foldl' :: (a -> Int -> a) -> a -> IntSet -> a
-foldl' f z t =
+foldl' f z = \t -> -- Use lambda t to be inlinable with two arguments only.
case t of Bin _ m l r | m < 0 -> go (go z r) l -- put negative numbers before
- _ -> go z t
+ | otherwise -> go (go z l) r
+ _ -> go z t
where
STRICT_1_OF_2(go)
go z' Nil = z'
@@ -789,11 +794,38 @@ toList
toAscList :: IntSet -> [Int]
toAscList = foldr (:) []
+-- | /O(n)/. Convert the set to a descending list of elements. Subject to list
+-- fusion.
+toDescList :: IntSet -> [Int]
+toDescList = foldl (flip (:)) []
+
+-- List fusion for the list generating functions.
#if __GLASGOW_HASKELL__
--- List fusion for the list generating functions
-{-# RULES "IntSet/elems" forall is . elems is = build (\c n -> foldr c n is) #-}
-{-# RULES "IntSet/toList" forall is . toList is = build (\c n -> foldr c n is) #-}
-{-# RULES "IntSet/toAscList" forall is . toAscList is = build (\c n -> foldr c n is) #-}
+-- The foldrFB and foldlFB are foldr and foldl equivalents, used for list fusion.
+-- They are important to convert unfused to{Asc,Desc}List back, see mapFB in prelude.
+foldrFB :: (Int -> b -> b) -> b -> IntSet -> b
+foldrFB = foldr
+{-# INLINE[0] foldrFB #-}
+foldlFB :: (a -> Int -> a) -> a -> IntSet -> a
+foldlFB = foldl
+{-# INLINE[0] foldlFB #-}
+
+-- Inline elems and toList, so that we need to fuse only toAscList.
+{-# INLINE elems #-}
+{-# INLINE toList #-}
+
+-- The fusion is enabled up to phase 2 included. If it does not succeed,
+-- convert in phase 1 the expanded to{Asc,Desc}List calls back to
+-- to{Asc,Desc}List. In phase 0, we inline fold{lr}FB (which were used in
+-- a list fusion, otherwise it would go away in phase 1), and let compiler do
+-- whatever it wants with to{Asc,Desc}List -- it was forbidden to inline it
+-- before phase 0, otherwise the fusion rules would not fire at all.
+{-# NOINLINE[0] toAscList #-}
+{-# NOINLINE[0] toDescList #-}
+{-# RULES "IntSet.toAscList" [~1] forall s . toAscList s = build (\c n -> foldrFB c n s) #-}
+{-# RULES "IntSet.toAscListBack" [1] foldrFB (:) [] = toAscList #-}
+{-# RULES "IntSet.toDescList" [~1] forall s . toDescList s = build (\c n -> foldlFB (\xs x -> c x xs) n s) #-}
+{-# RULES "IntSet.toDescListBack" [1] foldlFB (\xs x -> x : xs) [] = toDescList #-}
#endif
View
82 Data/Map/Base.hs
@@ -219,7 +219,6 @@ module Data.Map.Base (
import Prelude hiding (lookup,map,filter,foldr,foldl,null)
import qualified Data.Set as Set
-import qualified Data.List as List
import Data.Monoid (Monoid(..))
import Control.Applicative (Applicative(..), (<$>))
import Data.Traversable (Traversable(traverse))
@@ -1190,8 +1189,17 @@ hedgeDiffWithKey f blo bhi t (Bin _ kx x l r)
-- > intersection (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "a"
intersection :: Ord k => Map k a -> Map k b -> Map k a
-intersection m1 m2
- = intersectionWithKey (\_ x _ -> x) m1 m2
+intersection Tip _ = Tip
+intersection _ Tip = Tip
+intersection t1@(Bin s1 k1 x1 l1 r1) t2@(Bin s2 k2 _ l2 r2) =
+ if s1 >= s2 then
+ case splitLookupWithKey k2 t1 of
+ (lt, Just (k, x), gt) -> join k x (intersection lt l2) (intersection gt r2)
+ (lt, Nothing, gt) -> merge (intersection lt l2) (intersection gt r2)
+ else
+ case splitLookup k1 t2 of
+ (lt, Just _, gt) -> join k1 x1 (intersection l1 lt) (intersection r1 gt)
+ (lt, Nothing, gt) -> merge (intersection l1 lt) (intersection r1 gt)
#if __GLASGOW_HASKELL__ >= 700
{-# INLINABLE intersection #-}
#endif
@@ -1219,18 +1227,13 @@ intersectionWithKey _ Tip _ = Tip
intersectionWithKey _ _ Tip = Tip
intersectionWithKey f t1@(Bin s1 k1 x1 l1 r1) t2@(Bin s2 k2 x2 l2 r2) =
if s1 >= s2 then
- let (lt,found,gt) = splitLookupWithKey k2 t1
- tl = intersectionWithKey f lt l2
- tr = intersectionWithKey f gt r2
- in case found of
- Just (k,x) -> join k (f k x x2) tl tr
- Nothing -> merge tl tr
- else let (lt,found,gt) = splitLookup k1 t2
- tl = intersectionWithKey f l1 lt
- tr = intersectionWithKey f r1 gt
- in case found of
- Just x -> join k1 (f k1 x1 x) tl tr
- Nothing -> merge tl tr
+ case splitLookupWithKey k2 t1 of
+ (lt, Just (k, x), gt) -> join k (f k x x2) (intersectionWithKey f lt l2) (intersectionWithKey f gt r2)
+ (lt, Nothing, gt) -> merge (intersectionWithKey f lt l2) (intersectionWithKey f gt r2)
+ else
+ case splitLookup k1 t2 of
+ (lt, Just x, gt) -> join k1 (f k1 x1 x) (intersectionWithKey f l1 lt) (intersectionWithKey f r1 gt)
+ (lt, Nothing, gt) -> merge (intersectionWithKey f l1 lt) (intersectionWithKey f r1 gt)
#if __GLASGOW_HASKELL__ >= 700
{-# INLINABLE intersectionWithKey #-}
#endif
@@ -1494,7 +1497,7 @@ mapAccumRWithKey f a (Bin sx kx x l r) =
-- > mapKeys (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 3 "c"
mapKeys :: Ord k2 => (k1->k2) -> Map k1 a -> Map k2 a
-mapKeys = mapKeysWith (\x _ -> x)
+mapKeys f = fromList . foldrWithKey (\k x xs -> (f k, x) : xs) []
#if __GLASGOW_HASKELL__ >= 700
{-# INLINABLE mapKeys #-}
#endif
@@ -1510,8 +1513,7 @@ mapKeys = mapKeysWith (\x _ -> x)
-- > mapKeysWith (++) (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 3 "cdab"
mapKeysWith :: Ord k2 => (a -> a -> a) -> (k1->k2) -> Map k1 a -> Map k2 a
-mapKeysWith c f = fromListWith c . List.map fFirst . toList
- where fFirst (x,y) = (f x, y)
+mapKeysWith c f = fromListWith c . foldrWithKey (\k x xs -> (f k, x) : xs) []
#if __GLASGOW_HASKELL__ >= 700
{-# INLINABLE mapKeysWith #-}
#endif
@@ -1760,17 +1762,45 @@ toAscList = foldrWithKey (\k x xs -> (k,x):xs) []
-- | /O(n)/. Convert the map to a list of key\/value pairs where the keys
-- are in descending order. Subject to list fusion.
+--
+-- > toDescList (fromList [(5,"a"), (3,"b")]) == [(5,"a"), (3,"b")]
+
toDescList :: Map k a -> [(k,a)]
-toDescList t = foldlWithKey (\xs k x -> (k,x):xs) [] t
+toDescList = foldlWithKey (\xs k x -> (k,x):xs) []
+-- List fusion for the list generating functions.
#if __GLASGOW_HASKELL__
--- List fusion for the list generating functions
-{-# RULES "Map/elems" forall m . elems m = build (\c n -> foldr c n m) #-}
-{-# RULES "Map/keys" forall m . keys m = build (\c n -> foldrWithKey (\k _ ks -> c k ks) n m) #-}
-{-# RULES "Map/assocs" forall m . assocs m = build (\c n -> foldrWithKey (\k x xs -> c (k,x) xs) n m) #-}
-{-# RULES "Map/toList" forall m . toList m = build (\c n -> foldrWithKey (\k x xs -> c (k,x) xs) n m) #-}
-{-# RULES "Map/toAscList" forall m . toAscList m = build (\c n -> foldrWithKey (\k x xs -> c (k,x) xs) n m) #-}
-{-# RULES "Map/toDescList" forall m . toDescList m = build (\c n -> foldlWithKey (\xs k x -> c (k,x) xs) n m) #-}
+-- The foldrFB and foldlFB are fold{r,l}WithKey equivalents, used for list fusion.
+-- They are important to convert unfused methods back, see mapFB in prelude.
+foldrFB :: (k -> a -> b -> b) -> b -> Map k a -> b
+foldrFB = foldrWithKey
+{-# INLINE[0] foldrFB #-}
+foldlFB :: (a -> k -> b -> a) -> a -> Map k b -> a
+foldlFB = foldlWithKey
+{-# INLINE[0] foldlFB #-}
+
+-- Inline assocs and toList, so that we need to fuse only toAscList.
+{-# INLINE assocs #-}
+{-# INLINE toList #-}
+
+-- The fusion is enabled up to phase 2 included. If it does not succeed,
+-- convert in phase 1 the expanded elems,keys,to{Asc,Desc}List calls back to
+-- elems,keys,to{Asc,Desc}List. In phase 0, we inline fold{lr}FB (which were
+-- used in a list fusion, otherwise it would go away in phase 1), and let compiler
+-- do whatever it wants with elems,keys,to{Asc,Desc}List -- it was forbidden to
+-- inline it before phase 0, otherwise the fusion rules would not fire at all.
+{-# NOINLINE[0] elems #-}
+{-# NOINLINE[0] keys #-}
+{-# NOINLINE[0] toAscList #-}
+{-# NOINLINE[0] toDescList #-}
+{-# RULES "Map.elems" [~1] forall m . elems m = build (\c n -> foldrFB (\_ x xs -> c x xs) n m) #-}
+{-# RULES "Map.elemsBack" [1] foldrFB (\_ x xs -> x : xs) [] = elems #-}
+{-# RULES "Map.keys" [~1] forall m . keys m = build (\c n -> foldrFB (\k _ xs -> c k xs) n m) #-}
+{-# RULES "Map.keysBack" [1] foldrFB (\k _ xs -> k : xs) [] = keys #-}
+{-# RULES "Map.toAscList" [~1] forall m . toAscList m = build (\c n -> foldrFB (\k x xs -> c (k,x) xs) n m) #-}
+{-# RULES "Map.toAscListBack" [1] foldrFB (\k x xs -> (k, x) : xs) [] = toAscList #-}
+{-# RULES "Map.toDescList" [~1] forall m . toDescList m = build (\c n -> foldlFB (\xs k x -> c (k,x) xs) n m) #-}
+{-# RULES "Map.toDescListBack" [1] foldlFB (\xs k x -> (k, x) : xs) [] = toDescList #-}
#endif
{--------------------------------------------------------------------
View
67 Data/Map/Strict.hs
@@ -223,7 +223,6 @@ module Data.Map.Strict
) where
import Prelude hiding (lookup,map,filter,foldr,foldl,null)
-import qualified Data.List as List
import Data.Map.Base hiding
( findWithDefault
@@ -250,9 +249,7 @@ import Data.Map.Base hiding
, mapAccum
, mapAccumWithKey
, mapAccumRWithKey
- , mapKeys
, mapKeysWith
- , mapKeysMonotonic
, fromList
, fromListWith
, fromListWithKey
@@ -827,18 +824,13 @@ intersectionWithKey _ Tip _ = Tip
intersectionWithKey _ _ Tip = Tip
intersectionWithKey f t1@(Bin s1 k1 x1 l1 r1) t2@(Bin s2 k2 x2 l2 r2) =
if s1 >= s2 then
- let (lt,found,gt) = splitLookupWithKey k2 t1
- tl = intersectionWithKey f lt l2
- tr = intersectionWithKey f gt r2
- in case found of
- Just (k,x) -> join k (f k x x2) tl tr
- Nothing -> merge tl tr
- else let (lt,found,gt) = splitLookup k1 t2
- tl = intersectionWithKey f l1 lt
- tr = intersectionWithKey f r1 gt
- in case found of
- Just x -> let x' = f k1 x1 x in x' `seq` join k1 x' tl tr
- Nothing -> merge tl tr
+ case splitLookupWithKey k2 t1 of
+ (lt, Just (k, x), gt) -> case f k x x2 of x' -> x' `seq` join k x' (intersectionWithKey f lt l2) (intersectionWithKey f gt r2)
+ (lt, Nothing, gt) -> merge (intersectionWithKey f lt l2) (intersectionWithKey f gt r2)
+ else
+ case splitLookup k1 t2 of
+ (lt, Just x, gt) -> case f k1 x1 x of x' -> x' `seq` join k1 x' (intersectionWithKey f l1 lt) (intersectionWithKey f r1 gt)
+ (lt, Nothing, gt) -> merge (intersectionWithKey f l1 lt) (intersectionWithKey f r1 gt)
#if __GLASGOW_HASKELL__ >= 700
{-# INLINABLE intersectionWithKey #-}
#endif
@@ -958,23 +950,6 @@ mapAccumRWithKey f a (Bin sx kx x l r) =
in x' `seq` (a3,Bin sx kx x' l' r')
-- | /O(n*log n)/.
--- @'mapKeys' f s@ is the map obtained by applying @f@ to each key of @s@.
---
--- The size of the result may be smaller if @f@ maps two or more distinct
--- keys to the same new key. In this case the value at the greatest of
--- the original keys is retained.
---
--- > mapKeys (+ 1) (fromList [(5,"a"), (3,"b")]) == fromList [(4, "b"), (6, "a")]
--- > mapKeys (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 1 "c"
--- > mapKeys (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 3 "c"
-
-mapKeys :: Ord k2 => (k1->k2) -> Map k1 a -> Map k2 a
-mapKeys = mapKeysWith (\x _ -> x)
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE mapKeys #-}
-#endif
-
--- | /O(n*log n)/.
-- @'mapKeysWith' c f s@ is the map obtained by applying @f@ to each key of @s@.
--
-- The size of the result may be smaller if @f@ maps two or more distinct
@@ -985,37 +960,11 @@ mapKeys = mapKeysWith (\x _ -> x)
-- > mapKeysWith (++) (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 3 "cdab"
mapKeysWith :: Ord k2 => (a -> a -> a) -> (k1->k2) -> Map k1 a -> Map k2 a
-mapKeysWith c f = fromListWith c . List.map fFirst . toList
- where fFirst (x,y) = (f x, y)
+mapKeysWith c f = fromListWith c . foldrWithKey (\k x xs -> (f k, x) : xs) []
#if __GLASGOW_HASKELL__ >= 700
{-# INLINABLE mapKeysWith #-}
#endif
-
--- | /O(n)/.
--- @'mapKeysMonotonic' f s == 'mapKeys' f s@, but works only when @f@
--- is strictly monotonic.
--- That is, for any values @x@ and @y@, if @x@ < @y@ then @f x@ < @f y@.
--- /The precondition is not checked./
--- Semi-formally, we have:
---
--- > and [x < y ==> f x < f y | x <- ls, y <- ls]
--- > ==> mapKeysMonotonic f s == mapKeys f s
--- > where ls = keys s
---
--- This means that @f@ maps distinct original keys to distinct resulting keys.
--- This function has better performance than 'mapKeys'.
---
--- > mapKeysMonotonic (\ k -> k * 2) (fromList [(5,"a"), (3,"b")]) == fromList [(6, "b"), (10, "a")]
--- > valid (mapKeysMonotonic (\ k -> k * 2) (fromList [(5,"a"), (3,"b")])) == True
--- > valid (mapKeysMonotonic (\ _ -> 1) (fromList [(5,"a"), (3,"b")])) == False
-
-mapKeysMonotonic :: (k1->k2) -> Map k1 a -> Map k2 a
-mapKeysMonotonic _ Tip = Tip
-mapKeysMonotonic f (Bin sz k x l r) =
- let k' = f k
- in k' `seq` Bin sz k' x (mapKeysMonotonic f l) (mapKeysMonotonic f r)
-
{--------------------------------------------------------------------
Lists
use [foldlStrict] to reduce demand on the control-stack
View
18 Data/Sequence.hs
@@ -5,18 +5,6 @@
#if __GLASGOW_HASKELL__ >= 703
{-# LANGUAGE Trustworthy #-}
#endif
-{-# OPTIONS_GHC -Wwarn #-}
-
--- The above -Wwarn is due to e.g.
---
--- {-# INLINE deep #-}
--- {-# SPECIALIZE INLINE deep :: Digit (Elem a) -> FingerTree (Node (Elem a))
--- -> Digit (Elem a) -> FingerTree (Elem a) #-}
---
--- SPECIALISE really is wrong here. We should either specialise or
--- inline. Not sure which is wanted. Newer GHCs will emit a warning
--- in this case.
-
-----------------------------------------------------------------------------
-- |
-- Module : Data.Sequence
@@ -335,8 +323,6 @@ instance NFData a => NFData (FingerTree a) where
rnf (Deep _ pr m sf) = rnf pr `seq` rnf m `seq` rnf sf
{-# INLINE deep #-}
-{-# SPECIALIZE INLINE deep :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
-{-# SPECIALIZE INLINE deep :: Digit (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
deep :: Sized a => Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep pr m sf = Deep (size pr + size m + size sf) pr m sf
@@ -471,14 +457,10 @@ instance Sized (Node a) where
size (Node3 v _ _ _) = v
{-# INLINE node2 #-}
-{-# SPECIALIZE node2 :: Elem a -> Elem a -> Node (Elem a) #-}
-{-# SPECIALIZE node2 :: Node a -> Node a -> Node (Node a) #-}
node2 :: Sized a => a -> a -> Node a
node2 a b = Node2 (size a + size b) a b
{-# INLINE node3 #-}
-{-# SPECIALIZE node3 :: Elem a -> Elem a -> Elem a -> Node (Elem a) #-}
-{-# SPECIALIZE node3 :: Node a -> Node a -> Node a -> Node (Node a) #-}
node3 :: Sized a => a -> a -> a -> Node a
node3 a b c = Node3 (size a + size b + size c) a b c
View
36 Data/Set.hs
@@ -127,6 +127,7 @@ module Data.Set (
-- ** Ordered list
, toAscList
+ , toDescList
, fromAscList
, fromDistinctAscList
@@ -622,11 +623,38 @@ toList = toAscList
toAscList :: Set a -> [a]
toAscList = foldr (:) []
+-- | /O(n)/. Convert the set to a descending list of elements. Subject to list
+-- fusion.
+toDescList :: Set a -> [a]
+toDescList = foldl (flip (:)) []
+
+-- List fusion for the list generating functions.
#if __GLASGOW_HASKELL__
--- List fusion for the list generating functions
-{-# RULES "Set/elems" forall s . elems s = build (\c n -> foldr c n s) #-}
-{-# RULES "Set/toList" forall s . toList s = build (\c n -> foldr c n s) #-}
-{-# RULES "Set/toAscList" forall s . toAscList s = build (\c n -> foldr c n s) #-}
+-- The foldrFB and foldlFB are foldr and foldl equivalents, used for list fusion.
+-- They are important to convert unfused to{Asc,Desc}List back, see mapFB in prelude.
+foldrFB :: (a -> b -> b) -> b -> Set a -> b
+foldrFB = foldr
+{-# INLINE[0] foldrFB #-}
+foldlFB :: (a -> b -> a) -> a -> Set b -> a
+foldlFB = foldl
+{-# INLINE[0] foldlFB #-}
+
+-- Inline elems and toList, so that we need to fuse only toAscList.
+{-# INLINE elems #-}
+{-# INLINE toList #-}
+
+-- The fusion is enabled up to phase 2 included. If it does not succeed,
+-- convert in phase 1 the expanded to{Asc,Desc}List calls back to
+-- to{Asc,Desc}List. In phase 0, we inline fold{lr}FB (which were used in
+-- a list fusion, otherwise it would go away in phase 1), and let compiler do
+-- whatever it wants with to{Asc,Desc}List -- it was forbidden to inline it
+-- before phase 0, otherwise the fusion rules would not fire at all.
+{-# NOINLINE[0] toAscList #-}
+{-# NOINLINE[0] toDescList #-}
+{-# RULES "Set.toAscList" [~1] forall s . toAscList s = build (\c n -> foldrFB c n s) #-}
+{-# RULES "Set.toAscListBack" [1] foldrFB (:) [] = toAscList #-}
+{-# RULES "Set.toDescList" [~1] forall s . toDescList s = build (\c n -> foldlFB (\xs x -> c x xs) n s) #-}
+{-# RULES "Set.toDescListBack" [1] foldlFB (\xs x -> x : xs) [] = toDescList #-}
#endif
-- | /O(n*log n)/. Create a set from a list of elements.
View
122 tests/intmap-properties.hs
@@ -10,7 +10,7 @@ import Data.Monoid
import Data.Maybe hiding (mapMaybe)
import Data.Ord
import Data.Function
-import Prelude hiding (lookup, null, map ,filter)
+import Prelude hiding (lookup, null, map, filter, foldr, foldl)
import qualified Prelude (map)
import Data.List (nub,sort)
@@ -67,6 +67,9 @@ main = defaultMainWithOpts
, testCase "mapAccum" test_mapAccum
, testCase "mapAccumWithKey" test_mapAccumWithKey
, testCase "mapAccumRWithKey" test_mapAccumRWithKey
+ , testCase "mapKeys" test_mapKeys
+ , testCase "mapKeysWith" test_mapKeysWith
+ , testCase "mapKeysMonotonic" test_mapKeysMonotonic
, testCase "elems" test_elems
, testCase "keys" test_keys
, testCase "keysSet" test_keysSet
@@ -76,6 +79,7 @@ main = defaultMainWithOpts
, testCase "fromListWith" test_fromListWith
, testCase "fromListWithKey" test_fromListWithKey
, testCase "toAscList" test_toAscList
+ , testCase "toDescList" test_toDescList
, testCase "showTree" test_showTree
, testCase "fromAscList" test_fromAscList
, testCase "fromAscListWith" test_fromAscListWith
@@ -120,8 +124,12 @@ main = defaultMainWithOpts
, testProperty "union sum" prop_unionSum
, testProperty "difference model" prop_differenceModel
, testProperty "intersection model" prop_intersectionModel
+ , testProperty "intersectionWith model" prop_intersectionWithModel
+ , testProperty "intersectionWithKey model" prop_intersectionWithKeyModel
, testProperty "fromAscList" prop_ordered
, testProperty "fromList then toList" prop_list
+ , testProperty "toDescList" prop_descList
+ , testProperty "toAscList+toDescList" prop_ascDescList
, testProperty "alter" prop_alter
, testProperty "index" prop_index
, testProperty "null" prop_null
@@ -130,13 +138,14 @@ main = defaultMainWithOpts
, testProperty "findWithDefault" prop_findWithDefault
, testProperty "findMin" prop_findMin
, testProperty "findMax" prop_findMax
- , testProperty "deleteMin" prop_deleteMin
- , testProperty "deleteMax" prop_deleteMax
+ , testProperty "deleteMin" prop_deleteMinModel
+ , testProperty "deleteMax" prop_deleteMaxModel
, testProperty "filter" prop_filter
, testProperty "partition" prop_partition
, testProperty "map" prop_map
, testProperty "fmap" prop_fmap
- , testProperty "split" prop_split
+ , testProperty "mapkeys" prop_mapkeys
+ , testProperty "split" prop_splitModel
, testProperty "foldr" prop_foldr
, testProperty "foldr'" prop_foldr'
, testProperty "foldl" prop_foldl
@@ -421,6 +430,22 @@ test_mapAccumRWithKey = mapAccumRWithKey f "Everything:" (fromList [(5,"a"), (3,
where
f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X")
+test_mapKeys :: Assertion
+test_mapKeys = do
+ mapKeys (+ 1) (fromList [(5,"a"), (3,"b")]) @?= fromList [(4, "b"), (6, "a")]
+ mapKeys (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) @?= singleton 1 "c"
+ mapKeys (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) @?= singleton 3 "c"
+
+test_mapKeysWith :: Assertion
+test_mapKeysWith = do
+ mapKeysWith (++) (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) @?= singleton 1 "cdab"
+ mapKeysWith (++) (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) @?= singleton 3 "cdab"
+
+test_mapKeysMonotonic :: Assertion
+test_mapKeysMonotonic = do
+ mapKeysMonotonic (+ 1) (fromList [(5,"a"), (3,"b")]) @?= fromList [(4, "b"), (6, "a")]
+ mapKeysMonotonic (\ k -> k * 2) (fromList [(5,"a"), (3,"b")]) @?= fromList [(6, "b"), (10, "a")]
+
----------------------------------------------------------------
-- Conversion
@@ -476,6 +501,9 @@ test_fromListWithKey = do
test_toAscList :: Assertion
test_toAscList = toAscList (fromList [(5,"a"), (3,"b")]) @?= [(3,"b"), (5,"a")]
+test_toDescList :: Assertion
+test_toDescList = toDescList (fromList [(5,"a"), (3,"b")]) @?= [(5,"a"), (3,"b")]
+
test_showTree :: Assertion
test_showTree =
(let t = fromDistinctAscList [(x,()) | x <- [1..5]]
@@ -614,32 +642,38 @@ test_findMax = findMax (fromList [(5,"a"), (3,"b")]) @?= (5,"a")
test_deleteMin :: Assertion
test_deleteMin = do
deleteMin (fromList [(5,"a"), (3,"b"), (7,"c")]) @?= fromList [(5,"a"), (7,"c")]
+ deleteMin (empty :: SMap) @?= empty
test_deleteMax :: Assertion
test_deleteMax = do
deleteMax (fromList [(5,"a"), (3,"b"), (7,"c")]) @?= fromList [(3,"b"), (5,"a")]
+ deleteMax (empty :: SMap) @?= empty
test_deleteFindMin :: Assertion
-test_deleteFindMin = deleteFindMin (fromList [(5,"a"), (3,"b"), (10,"c")]) @?= ("b", fromList[(5,"a"), (10,"c")])
+test_deleteFindMin = deleteFindMin (fromList [(5,"a"), (3,"b"), (10,"c")]) @?= ((3,"b"), fromList[(5,"a"), (10,"c")])
test_deleteFindMax :: Assertion
-test_deleteFindMax = deleteFindMax (fromList [(5,"a"), (3,"b"), (10,"c")]) @?= ("c", fromList [(3,"b"), (5,"a")])
+test_deleteFindMax = deleteFindMax (fromList [(5,"a"), (3,"b"), (10,"c")]) @?= ((10,"c"), fromList [(3,"b"), (5,"a")])
test_updateMin :: Assertion
test_updateMin = do
- updateMin ("X" ++) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "Xb"), (5, "a")]
+ updateMin (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "Xb"), (5, "a")]
+ updateMin (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
test_updateMax :: Assertion
test_updateMax = do
- updateMax ("X" ++) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "Xa")]
+ updateMax (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "Xa")]
+ updateMax (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
test_updateMinWithKey :: Assertion
test_updateMinWithKey = do
- updateMinWithKey (\ k a -> (show k) ++ ":" ++ a) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3,"3:b"), (5,"a")]
+ updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3,"3:b"), (5,"a")]
+ updateMinWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
test_updateMaxWithKey :: Assertion
test_updateMaxWithKey = do
- updateMaxWithKey (\ k a -> (show k) ++ ":" ++ a) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3,"b"), (5,"5:a")]
+ updateMaxWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3,"b"), (5,"5:a")]
+ updateMaxWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
test_minView :: Assertion
test_minView = do
@@ -708,6 +742,22 @@ prop_intersectionModel xs ys
= sort (keys (intersection (fromListWith (+) xs) (fromListWith (+) ys)))
== sort (nub ((List.intersect) (Prelude.map fst xs) (Prelude.map fst ys)))
+prop_intersectionWithModel :: [(Int,Int)] -> [(Int,Int)] -> Bool
+prop_intersectionWithModel xs ys
+ = toList (intersectionWith f (fromList xs') (fromList ys'))
+ == [(kx, f vx vy ) | (kx, vx) <- List.sort xs', (ky, vy) <- ys', kx == ky]
+ where xs' = List.nubBy ((==) `on` fst) xs
+ ys' = List.nubBy ((==) `on` fst) ys
+ f l r = l + 2 * r
+
+prop_intersectionWithKeyModel :: [(Int,Int)] -> [(Int,Int)] -> Bool
+prop_intersectionWithKeyModel xs ys
+ = toList (intersectionWithKey f (fromList xs') (fromList ys'))
+ == [(kx, f kx vx vy) | (kx, vx) <- List.sort xs', (ky, vy) <- ys', kx == ky]
+ where xs' = List.nubBy ((==) `on` fst) xs
+ ys' = List.nubBy ((==) `on` fst) ys
+ f k l r = k + 2 * l + 3 * r
+
----------------------------------------------------------------
prop_ordered :: Property
@@ -719,6 +769,13 @@ prop_ordered
prop_list :: [Int] -> Bool
prop_list xs = (sort (nub xs) == [x | (x,()) <- toList (fromList [(x,()) | x <- xs])])
+prop_descList :: [Int] -> Bool
+prop_descList xs = (reverse (sort (nub xs)) == [x | (x,()) <- toDescList (fromList [(x,()) | x <- xs])])
+
+prop_ascDescList :: [Int] -> Bool
+prop_ascDescList xs = toAscList m == reverse (toDescList m)
+ where m = fromList $ zip xs $ repeat ()
+
----------------------------------------------------------------
prop_alter :: UMap -> Int -> Bool
@@ -731,7 +788,7 @@ prop_alter t k = case lookup k t of
f (Just ()) = Nothing
------------------------------------------------------------------------
--- New tests: compare against the list model (after nub on keys)
+-- Compare against the list model (after nub on keys)
prop_index :: [Int] -> Property
prop_index xs = length xs > 0 ==>
@@ -769,14 +826,14 @@ prop_findMax ys = length ys > 0 ==>
m = fromList xs
in findMax m == List.maximumBy (comparing fst) xs
-prop_deleteMin :: [(Int, Int)] -> Property
-prop_deleteMin ys = length ys > 0 ==>
+prop_deleteMinModel :: [(Int, Int)] -> Property
+prop_deleteMinModel ys = length ys > 0 ==>
let xs = List.nubBy ((==) `on` fst) ys
m = fromList xs
in toAscList (deleteMin m) == tail (sort xs)
-prop_deleteMax :: [(Int, Int)] -> Property
-prop_deleteMax ys = length ys > 0 ==>
+prop_deleteMaxModel :: [(Int, Int)] -> Property
+prop_deleteMaxModel ys = length ys > 0 ==>
let xs = List.nubBy ((==) `on` fst) ys
m = fromList xs
in toAscList (deleteMax m) == init (sort xs)
@@ -805,8 +862,14 @@ prop_fmap f ys = length ys > 0 ==>
m = fromList xs
in fmap f m == fromList [ (a, f b) | (a,b) <- xs ]
-prop_split :: Int -> [(Int, Int)] -> Property
-prop_split n ys = length ys > 0 ==>
+prop_mapkeys :: (Int -> Int) -> [(Int, Int)] -> Property
+prop_mapkeys f ys = length ys > 0 ==>
+ let xs = List.nubBy ((==) `on` fst) ys
+ m = fromList xs
+ in mapKeys f m == (fromList $ List.nubBy ((==) `on` fst) $ reverse [ (f a, b) | (a,b) <- sort xs])
+
+prop_splitModel :: Int -> [(Int, Int)] -> Property
+prop_splitModel n ys = length ys > 0 ==>
let xs = List.nubBy ((==) `on` fst) ys
(l, r) = split n $ fromList xs
in toAscList l == sort [(k, v) | (k,v) <- xs, k < n] &&
@@ -816,22 +879,39 @@ prop_foldr :: Int -> [(Int, Int)] -> Property
prop_foldr n ys = length ys > 0 ==>
let xs = List.nubBy ((==) `on` fst) ys
m = fromList xs
- in foldrWithKey (\_ a b -> a + b) n m == List.foldr (+) n (List.map snd xs)
+ in foldr (+) n m == List.foldr (+) n (List.map snd xs) &&
+ foldr (:) [] m == List.map snd (List.sort xs) &&
+ foldrWithKey (\_ a b -> a + b) n m == List.foldr (+) n (List.map snd xs) &&
+ foldrWithKey (\k _ b -> k + b) n m == List.foldr (+) n (List.map fst xs) &&
+ foldrWithKey (\k x xs -> (k,x):xs) [] m == List.sort xs
+
prop_foldr' :: Int -> [(Int, Int)] -> Property
prop_foldr' n ys = length ys > 0 ==>
let xs = List.nubBy ((==) `on` fst) ys
m = fromList xs
- in foldrWithKey' (\_ a b -> a + b) n m == List.foldr (+) n (List.map snd xs)
+ in foldr' (+) n m == List.foldr (+) n (List.map snd xs) &&
+ foldr' (:) [] m == List.map snd (List.sort xs) &&
+ foldrWithKey' (\_ a b -> a + b) n m == List.foldr (+) n (List.map snd xs) &&
+ foldrWithKey' (\k _ b -> k + b) n m == List.foldr (+) n (List.map fst xs) &&
+ foldrWithKey' (\k x xs -> (k,x):xs) [] m == List.sort xs
prop_foldl :: Int -> [(Int, Int)] -> Property
prop_foldl n ys = length ys > 0 ==>
let xs = List.nubBy ((==) `on` fst) ys
m = fromList xs
- in foldlWithKey (\a _ b -> a + b) n m == List.foldr (+) n (List.map snd xs)
+ in foldl (+) n m == List.foldr (+) n (List.map snd xs) &&
+ foldl (flip (:)) [] m == reverse (List.map snd (List.sort xs)) &&
+ foldlWithKey (\b _ a -> a + b) n m == List.foldr (+) n (List.map snd xs) &&
+ foldlWithKey (\b k _ -> k + b) n m == List.foldr (+) n (List.map fst xs) &&
+ foldlWithKey (\xs k x -> (k,x):xs) [] m == reverse (List.sort xs)
prop_foldl' :: Int -> [(Int, Int)] -> Property
prop_foldl' n ys = length ys > 0 ==>
let xs = List.nubBy ((==) `on` fst) ys
m = fromList xs
- in foldlWithKey' (\a _ b -> a + b) n m == List.foldr (+) n (List.map snd xs)
+ in foldl' (+) n m == List.foldr (+) n (List.map snd xs) &&
+ foldl' (flip (:)) [] m == reverse (List.map snd (List.sort xs)) &&
+ foldlWithKey' (\b _ a -> a + b) n m == List.foldr (+) n (List.map snd xs) &&
+ foldlWithKey' (\b k _ -> k + b) n m == List.foldr (+) n (List.map fst xs) &&
+ foldlWithKey' (\xs k x -> (k,x):xs) [] m == reverse (List.sort xs)
View
9 tests/intset-properties.hs
@@ -20,6 +20,8 @@ main = defaultMainWithOpts [ testProperty "prop_Single" prop_Single
, testProperty "prop_Int" prop_Int
, testProperty "prop_Ordered" prop_Ordered
, testProperty "prop_List" prop_List
+ , testProperty "prop_DescList" prop_DescList
+ , testProperty "prop_AscDescList" prop_AscDescList
, testProperty "prop_fromList" prop_fromList
, testProperty "prop_MaskPow2" prop_MaskPow2
, testProperty "prop_Prefix" prop_Prefix
@@ -114,6 +116,13 @@ prop_List :: [Int] -> Bool
prop_List xs
= (sort (nub xs) == toAscList (fromList xs))
+prop_DescList :: [Int] -> Bool
+prop_DescList xs = (reverse (sort (nub xs)) == toDescList (fromList xs))
+
+prop_AscDescList :: [Int] -> Bool
+prop_AscDescList xs = toAscList s == reverse (toDescList s)
+ where s = fromList xs
+
prop_fromList :: [Int] -> Bool
prop_fromList xs
= case fromList xs of
View
71 tests/map-properties.hs
@@ -10,7 +10,7 @@ import Data.Monoid
import Data.Maybe hiding (mapMaybe)
import Data.Ord
import Data.Function
-import Prelude hiding (lookup, null, map, filter)
+import Prelude hiding (lookup, null, map, filter, foldr, foldl)
import qualified Prelude (map)
import Data.List (nub,sort)
@@ -143,8 +143,14 @@ main = defaultMainWithOpts
, testProperty "difference model" prop_differenceModel
, testProperty "intersection" prop_intersection
, testProperty "intersection model" prop_intersectionModel
+ , testProperty "intersectionWith" prop_intersectionWith
+ , testProperty "intersectionWithModel" prop_intersectionWithModel
+ , testProperty "intersectionWithKey" prop_intersectionWithKey
+ , testProperty "intersectionWithKeyModel" prop_intersectionWithKeyModel
, testProperty "fromAscList" prop_ordered
, testProperty "fromList then toList" prop_list
+ , testProperty "toDescList" prop_descList
+ , testProperty "toAscList+toDescList" prop_ascDescList
, testProperty "alter" prop_alter
, testProperty "index" prop_index
, testProperty "null" prop_null
@@ -467,6 +473,7 @@ test_mapKeysWith = do
test_mapKeysMonotonic :: Assertion
test_mapKeysMonotonic = do
+ mapKeysMonotonic (+ 1) (fromList [(5,"a"), (3,"b")]) @?= fromList [(4, "b"), (6, "a")]
mapKeysMonotonic (\ k -> k * 2) (fromList [(5,"a"), (3,"b")]) @?= fromList [(6, "b"), (10, "a")]
valid (mapKeysMonotonic (\ k -> k * 2) (fromList [(5,"a"), (3,"b")])) @?= True
valid (mapKeysMonotonic (\ _ -> 1) (fromList [(5,"a"), (3,"b")])) @?= False
@@ -866,6 +873,28 @@ prop_intersectionModel xs ys
= sort (keys (intersection (fromListWith (+) xs) (fromListWith (+) ys)))
== sort (nub ((List.intersect) (Prelude.map fst xs) (Prelude.map fst ys)))
+prop_intersectionWith :: (Int -> Int -> Maybe Int) -> IMap -> IMap -> Bool
+prop_intersectionWith f t1 t2 = valid (intersectionWith f t1 t2)
+
+prop_intersectionWithModel :: [(Int,Int)] -> [(Int,Int)] -> Bool
+prop_intersectionWithModel xs ys
+ = toList (intersectionWith f (fromList xs') (fromList ys'))
+ == [(kx, f vx vy) | (kx, vx) <- List.sort xs', (ky, vy) <- ys', kx == ky]
+ where xs' = List.nubBy ((==) `on` fst) xs
+ ys' = List.nubBy ((==) `on` fst) ys
+ f l r = l + 2 * r
+
+prop_intersectionWithKey :: (Int -> Int -> Int -> Maybe Int) -> IMap -> IMap -> Bool
+prop_intersectionWithKey f t1 t2 = valid (intersectionWithKey f t1 t2)
+
+prop_intersectionWithKeyModel :: [(Int,Int)] -> [(Int,Int)] -> Bool
+prop_intersectionWithKeyModel xs ys
+ = toList (intersectionWithKey f (fromList xs') (fromList ys'))
+ == [(kx, f kx vx vy) | (kx, vx) <- List.sort xs', (ky, vy) <- ys', kx == ky]
+ where xs' = List.nubBy ((==) `on` fst) xs
+ ys' = List.nubBy ((==) `on` fst) ys
+ f k l r = k + 2 * l + 3 * r
+
----------------------------------------------------------------
prop_ordered :: Property
@@ -877,6 +906,13 @@ prop_ordered
prop_list :: [Int] -> Bool
prop_list xs = (sort (nub xs) == [x | (x,()) <- toList (fromList [(x,()) | x <- xs])])
+prop_descList :: [Int] -> Bool
+prop_descList xs = (reverse (sort (nub xs)) == [x | (x,()) <- toDescList (fromList [(x,()) | x <- xs])])
+
+prop_ascDescList :: [Int] -> Bool
+prop_ascDescList xs = toAscList m == reverse (toDescList m)
+ where m = fromList $ zip xs $ repeat ()
+
----------------------------------------------------------------
prop_alter :: UMap -> Int -> Bool
@@ -897,7 +933,7 @@ prop_index xs = length xs > 0 ==>
in xs == [ m ! i | i <- xs ]
prop_null :: IMap -> Bool
-prop_null m = Data.Map.null m == (size m == 0)
+prop_null m = null m == (size m == 0)
prop_member :: [Int] -> Int -> Bool
prop_member xs n =
@@ -953,19 +989,19 @@ prop_filter :: (Int -> Bool) -> [(Int, Int)] -> Property
prop_filter p ys = length ys > 0 ==>
let xs = List.nubBy ((==) `on` fst) ys
m = fromList xs
- in Data.Map.filter p m == fromList (List.filter (p . snd) xs)
+ in filter p m == fromList (List.filter (p . snd) xs)
prop_partition :: (Int -> Bool) -> [(Int, Int)] -> Property
prop_partition p ys = length ys > 0 ==>
let xs = List.nubBy ((==) `on` fst) ys
m = fromList xs
- in Data.Map.partition p m == let (a,b) = (List.partition (p . snd) xs) in (fromList a, fromList b)
+ in partition p m == let (a,b) = (List.partition (p . snd) xs) in (fromList a, fromList b)
prop_map :: (Int -> Int) -> [(Int, Int)] -> Property
prop_map f ys = length ys > 0 ==>
let xs = List.nubBy ((==) `on` fst) ys
m = fromList xs
- in Data.Map.map f m == fromList [ (a, f b) | (a,b) <- xs ]
+ in map f m == fromList [ (a, f b) | (a,b) <- xs ]
prop_fmap :: (Int -> Int) -> [(Int, Int)] -> Property
prop_fmap f ys = length ys > 0 ==>
@@ -990,22 +1026,39 @@ prop_foldr :: Int -> [(Int, Int)] -> Property
prop_foldr n ys = length ys > 0 ==>
let xs = List.nubBy ((==) `on` fst) ys
m = fromList xs
- in Data.Map.foldrWithKey (\_ a b -> a + b) n m == List.foldr (+) n (List.map snd xs)
+ in foldr (+) n m == List.foldr (+) n (List.map snd xs) &&
+ foldr (:) [] m == List.map snd (List.sort xs) &&
+ foldrWithKey (\_ a b -> a + b) n m == List.foldr (+) n (List.map snd xs) &&
+ foldrWithKey (\k _ b -> k + b) n m == List.foldr (+) n (List.map fst xs) &&
+ foldrWithKey (\k x xs -> (k,x):xs) [] m == List.sort xs
+
prop_foldr' :: Int -> [(Int, Int)] -> Property
prop_foldr' n ys = length ys > 0 ==>
let xs = List.nubBy ((==) `on` fst) ys
m = fromList xs
- in Data.Map.foldrWithKey' (\_ a b -> a + b) n m == List.foldr (+) n (List.map snd xs)
+ in foldr' (+) n m == List.foldr (+) n (List.map snd xs) &&
+ foldr' (:) [] m == List.map snd (List.sort xs) &&
+ foldrWithKey' (\_ a b -> a + b) n m == List.foldr (+) n (List.map snd xs) &&
+ foldrWithKey' (\k _ b -> k + b) n m == List.foldr (+) n (List.map fst xs) &&
+ foldrWithKey' (\k x xs -> (k,x):xs) [] m == List.sort xs
prop_foldl :: Int -> [(Int, Int)] -> Property
prop_foldl n ys = length ys > 0 ==>
let xs = List.nubBy ((==) `on` fst) ys
m = fromList xs
- in Data.Map.foldlWithKey (\a _ b -> a + b) n m == List.foldr (+) n (List.map snd xs)
+ in foldl (+) n m == List.foldr (+) n (List.map snd xs) &&
+ foldl (flip (:)) [] m == reverse (List.map snd (List.sort xs)) &&
+ foldlWithKey (\b _ a -> a + b) n m == List.foldr (+) n (List.map snd xs) &&
+ foldlWithKey (\b k _ -> k + b) n m == List.foldr (+) n (List.map fst xs) &&
+ foldlWithKey (\xs k x -> (k,x):xs) [] m == reverse (List.sort xs)
prop_foldl' :: Int -> [(Int, Int)] -> Property
prop_foldl' n ys = length ys > 0 ==>
let xs = List.nubBy ((==) `on` fst) ys
m = fromList xs
- in Data.Map.foldlWithKey' (\a _ b -> a + b) n m == List.foldr (+) n (List.map snd xs)
+ in foldl' (+) n m == List.foldr (+) n (List.map snd xs) &&
+ foldl' (flip (:)) [] m == reverse (List.map snd (List.sort xs)) &&
+ foldlWithKey' (\b _ a -> a + b) n m == List.foldr (+) n (List.map snd xs) &&
+ foldlWithKey' (\b k _ -> k + b) n m == List.foldr (+) n (List.map fst xs) &&
+ foldlWithKey' (\xs k x -> (k,x):xs) [] m == reverse (List.sort xs)
View
9 tests/set-properties.hs
@@ -26,6 +26,8 @@ main = defaultMainWithOpts [ testProperty "prop_Valid" prop_Valid
, testProperty "prop_Int" prop_Int
, testProperty "prop_Ordered" prop_Ordered
, testProperty "prop_List" prop_List
+ , testProperty "prop_DescList" prop_DescList
+ , testProperty "prop_AscDescList" prop_AscDescList
, testProperty "prop_fromList" prop_fromList
, testProperty "prop_isProperSubsetOf" prop_isProperSubsetOf
, testProperty "prop_isProperSubsetOf2" prop_isProperSubsetOf2
@@ -170,6 +172,13 @@ prop_Ordered = forAll (choose (5,100)) $ \n ->
prop_List :: [Int] -> Bool
prop_List xs = (sort (nub xs) == toList (fromList xs))
+prop_DescList :: [Int] -> Bool
+prop_DescList xs = (reverse (sort (nub xs)) == toDescList (fromList xs))
+
+prop_AscDescList :: [Int] -> Bool
+prop_AscDescList xs = toAscList s == reverse (toDescList s)
+ where s = fromList xs
+
prop_fromList :: [Int] -> Bool
prop_fromList xs
= case fromList xs of

No commit comments for this range

Something went wrong with that request. Please try again.