Skip to content

Commit 81bf0db

Browse files
authored
Merge pull request #15 from karshan/master
Add intersection,intersectionWith for Data.Map
2 parents 67a0263 + ca68958 commit 81bf0db

File tree

3 files changed

+38
-1
lines changed

3 files changed

+38
-1
lines changed

src/Data/Map.purs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@ module Data.Map
55

66
import Prelude
77

8-
import Data.Map.Internal (Map, alter, checkValid, delete, empty, filter, filterKeys, filterWithKey, findMax, findMin, foldSubmap, fromFoldable, fromFoldableWith, fromFoldableWithIndex, insert, insertWith, isEmpty, isSubmap, lookup, lookupGE, lookupGT, lookupLE, lookupLT, member, pop, showTree, singleton, size, submap, toUnfoldable, toUnfoldableUnordered, union, unionWith, unions, difference, update, values, mapMaybeWithKey, mapMaybe)
8+
import Data.Map.Internal (Map, alter, checkValid, delete, empty, filter, filterKeys, filterWithKey, findMax, findMin, foldSubmap, fromFoldable, fromFoldableWith, fromFoldableWithIndex, insert, insertWith, isEmpty, isSubmap, lookup, lookupGE, lookupGT, lookupLE, lookupLT, member, pop, showTree, singleton, size, submap, toUnfoldable, toUnfoldableUnordered, union, unionWith, unions, intersection, intersectionWith, difference, update, values, mapMaybeWithKey, mapMaybe)
99
import Data.Set (Set)
1010
import Unsafe.Coerce (unsafeCoerce)
1111

src/Data/Map/Internal.purs

Lines changed: 20 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -34,6 +34,8 @@ module Data.Map.Internal
3434
, union
3535
, unionWith
3636
, unions
37+
, intersection
38+
, intersectionWith
3739
, difference
3840
, isSubmap
3941
, size
@@ -628,6 +630,24 @@ union = unionWith const
628630
unions :: forall k v f. Ord k => Foldable f => f (Map k v) -> Map k v
629631
unions = foldl union empty
630632

633+
-- | Compute the intersection of two maps, using the specified function
634+
-- | to combine values for duplicate keys.
635+
intersectionWith :: forall k a b c. Ord k => (a -> b -> c) -> Map k a -> Map k b -> Map k c
636+
intersectionWith f m1 m2 = go (toUnfoldable m1 :: List (Tuple k a)) (toUnfoldable m2 :: List (Tuple k b)) empty
637+
where
638+
go Nil _ m = m
639+
go _ Nil m = m
640+
go as@(Cons (Tuple k1 a) ass) bs@(Cons (Tuple k2 b) bss) m =
641+
case compare k1 k2 of
642+
LT -> go ass bs m
643+
EQ -> go ass bss (insert k1 (f a b) m)
644+
GT -> go as bss m
645+
646+
-- | Compute the intersection of two maps, preferring values from the first map in the case
647+
-- | of duplicate keys.
648+
intersection :: forall k a b. Ord k => Map k a -> Map k b -> Map k a
649+
intersection = intersectionWith const
650+
631651
-- | Difference of two maps. Return elements of the first map where
632652
-- | the keys do not exist in the second map.
633653
difference :: forall k v w. Ord k => Map k v -> Map k w -> Map k v

test/Test/Data/Map.purs

Lines changed: 17 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -223,6 +223,23 @@ mapTests = do
223223
Just v -> Just v == v2
224224
Nothing -> not (in1 || in2)
225225

226+
log "Lookup from intersection"
227+
quickCheck $ \(TestMap m1) (TestMap m2) k ->
228+
M.lookup (smallKey k) (M.intersection (m1 :: M.Map SmallKey Int) (m2 :: M.Map SmallKey Int)) == (case M.lookup k m2 of
229+
Nothing -> Nothing
230+
Just v -> M.lookup k m1) <?> ("m1: " <> show m1 <> ", m2: " <> show m2 <> ", k: " <> show k <> ", v1: " <> show (M.lookup k m1) <> ", v2: " <> show (M.lookup k m2) <> ", intersection: " <> show (M.intersection m1 m2))
231+
232+
log "Intersection is idempotent"
233+
quickCheck $ \(TestMap m1) (TestMap m2) -> ((m1 :: M.Map SmallKey Int) `M.intersection` m2) == ((m1 `M.intersection` m2) `M.intersection` (m2 :: M.Map SmallKey Int))
234+
235+
log "intersectionWith"
236+
for_ [(+), (*)] $ \op ->
237+
quickCheck $ \(TestMap m1) (TestMap m2) k ->
238+
let u = M.intersectionWith op m1 m2 :: M.Map SmallKey Int
239+
in case M.lookup k u of
240+
Nothing -> not (M.member k m1 && M.member k m2)
241+
Just v -> Just v == (op <$> M.lookup k m1 <*> M.lookup k m2)
242+
226243
log "difference"
227244
quickCheck $ \(TestMap m1) (TestMap m2) ->
228245
let d = M.difference (m1 :: M.Map SmallKey Int) (m2 :: M.Map SmallKey String)

0 commit comments

Comments
 (0)