From 1e192e981d315bd5268f6ff2ad3ddbd18a18b71f Mon Sep 17 00:00:00 2001
From: Simon Jakobi <simon.jakobi@gmail.com>
Date: Mon, 24 Jun 2019 01:02:24 +0200
Subject: [PATCH] Add disjoint for Map and IntMap (#642)
Add disjoint for `Map` and `IntMap`.
Closes #641.
---
.gitignore | 1 +
containers-tests/tests/intmap-properties.hs | 4 +++
containers-tests/tests/map-properties.hs | 4 +++
containers/src/Data/IntMap/Internal.hs | 34 ++++++++++++++++++-
containers/src/Data/IntMap/Lazy.hs | 3 ++
containers/src/Data/IntMap/Strict.hs | 3 ++
containers/src/Data/IntMap/Strict/Internal.hs | 4 +++
containers/src/Data/Map/Internal.hs | 30 ++++++++++++++++
containers/src/Data/Map/Lazy.hs | 3 ++
containers/src/Data/Map/Strict.hs | 3 ++
containers/src/Data/Map/Strict/Internal.hs | 4 +++
11 files changed, 92 insertions(+), 1 deletion(-)
diff --git a/.gitignore b/.gitignore
index b599dc2e..77c2680d 100644
--- a/.gitignore
+++ b/.gitignore
@@ -3,6 +3,7 @@
*.o
*.p_hi
*.prof
+*.swo
*.tix
.hpc/
/dist/*
diff --git a/containers-tests/tests/intmap-properties.hs b/containers-tests/tests/intmap-properties.hs
index 7ac8f595..86eb6276 100644
--- a/containers-tests/tests/intmap-properties.hs
+++ b/containers-tests/tests/intmap-properties.hs
@@ -162,6 +162,7 @@ main = defaultMain
, testProperty "lookupGT" prop_lookupGT
, testProperty "lookupLE" prop_lookupLE
, testProperty "lookupGE" prop_lookupGE
+ , testProperty "disjoint" prop_disjoint
, testProperty "lookupMin" prop_lookupMin
, testProperty "lookupMax" prop_lookupMax
, testProperty "findMin" prop_findMin
@@ -880,6 +881,9 @@ prop_intersectionWithKeyModel xs ys
ys' = List.nubBy ((==) `on` fst) ys
f k l r = k + 2 * l + 3 * r
+prop_disjoint :: UMap -> UMap -> Property
+prop_disjoint m1 m2 = disjoint m1 m2 === null (intersection m1 m2)
+
-- TODO: the second argument should be simply an 'IntSet', but that
-- runs afoul of our orphan instance.
prop_restrictKeys :: IMap -> IMap -> Property
diff --git a/containers-tests/tests/map-properties.hs b/containers-tests/tests/map-properties.hs
index 59522f3f..c1bff016 100644
--- a/containers-tests/tests/map-properties.hs
+++ b/containers-tests/tests/map-properties.hs
@@ -172,6 +172,7 @@ main = defaultMain
, testProperty "intersectionWithModel" prop_intersectionWithModel
, testProperty "intersectionWithKey" prop_intersectionWithKey
, testProperty "intersectionWithKeyModel" prop_intersectionWithKeyModel
+ , testProperty "disjoint" prop_disjoint
, testProperty "differenceMerge" prop_differenceMerge
, testProperty "unionWithKeyMerge" prop_unionWithKeyMerge
, testProperty "mergeWithKey model" prop_mergeWithKeyModel
@@ -1070,6 +1071,9 @@ prop_intersectionWithKeyModel xs ys
ys' = List.nubBy ((==) `on` fst) ys
f k l r = k + 2 * l + 3 * r
+prop_disjoint :: UMap -> UMap -> Property
+prop_disjoint m1 m2 = disjoint m1 m2 === null (intersection m1 m2)
+
prop_mergeWithKeyModel :: [(Int,Int)] -> [(Int,Int)] -> Bool
prop_mergeWithKeyModel xs ys
= and [ testMergeWithKey f keep_x keep_y
diff --git a/containers/src/Data/IntMap/Internal.hs b/containers/src/Data/IntMap/Internal.hs
index edc2bf83..9e240314 100644
--- a/containers/src/Data/IntMap/Internal.hs
+++ b/containers/src/Data/IntMap/Internal.hs
@@ -90,6 +90,7 @@ module Data.IntMap.Internal (
, lookupGT
, lookupLE
, lookupGE
+ , disjoint
-- * Construction
, empty
@@ -372,7 +373,7 @@ data IntMap a = Bin {-# UNPACK #-} !Prefix
-- two keys of the map differ.
-- Invariant: Prefix is the common high-order bits that all elements share to
-- the left of the Mask bit.
--- Invariant: In Bin prefix mask left right, left consists of the elements that
+-- Invariant: In (Bin prefix mask left right), left consists of the elements that
-- don't have the mask bit set; right is all the elements that do.
| Tip {-# UNPACK #-} !Key a
| Nil
@@ -728,6 +729,37 @@ unsafeFindMax Nil = Nothing
unsafeFindMax (Tip ky y) = Just (ky, y)
unsafeFindMax (Bin _ _ _ r) = unsafeFindMax r
+{--------------------------------------------------------------------
+ Disjoint
+--------------------------------------------------------------------}
+-- | /O(n+m)/. Check whether the key sets of two maps are disjoint
+-- (i.e. their 'intersection' is empty).
+--
+-- > disjoint (fromList [(2,'a')]) (fromList [(1,()), (3,())]) == True
+-- > disjoint (fromList [(2,'a')]) (fromList [(1,'a'), (2,'b')]) == False
+-- > disjoint (fromList []) (fromList []) == True
+--
+-- > disjoint a b == null (intersection a b)
+--
+-- @since UNRELEASED
+disjoint :: IntMap a -> IntMap b -> Bool
+disjoint Nil _ = True
+disjoint _ Nil = True
+disjoint (Tip kx _) ys = notMember kx ys
+disjoint xs (Tip ky _) = notMember ky xs
+disjoint t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
+ | shorter m1 m2 = disjoint1
+ | shorter m2 m1 = disjoint2
+ | p1 == p2 = disjoint l1 l2 && disjoint r1 r2
+ | otherwise = True
+ where
+ disjoint1 | nomatch p2 p1 m1 = True
+ | zero p2 m1 = disjoint l1 t2
+ | otherwise = disjoint r1 t2
+ disjoint2 | nomatch p1 p2 m2 = True
+ | zero p1 m2 = disjoint t1 l2
+ | otherwise = disjoint t1 r2
+
{--------------------------------------------------------------------
Construction
--------------------------------------------------------------------}
diff --git a/containers/src/Data/IntMap/Lazy.hs b/containers/src/Data/IntMap/Lazy.hs
index 57b26eee..d09f2624 100644
--- a/containers/src/Data/IntMap/Lazy.hs
+++ b/containers/src/Data/IntMap/Lazy.hs
@@ -143,6 +143,9 @@ module Data.IntMap.Lazy (
, intersectionWith
, intersectionWithKey
+ -- ** Disjoint
+ , disjoint
+
-- ** Universal combining function
, mergeWithKey
diff --git a/containers/src/Data/IntMap/Strict.hs b/containers/src/Data/IntMap/Strict.hs
index 88bdc939..b0ab5ccb 100644
--- a/containers/src/Data/IntMap/Strict.hs
+++ b/containers/src/Data/IntMap/Strict.hs
@@ -162,6 +162,9 @@ module Data.IntMap.Strict (
, intersectionWith
, intersectionWithKey
+ -- ** Disjoint
+ , disjoint
+
-- ** Universal combining function
, mergeWithKey
diff --git a/containers/src/Data/IntMap/Strict/Internal.hs b/containers/src/Data/IntMap/Strict/Internal.hs
index f53280ee..9957a041 100644
--- a/containers/src/Data/IntMap/Strict/Internal.hs
+++ b/containers/src/Data/IntMap/Strict/Internal.hs
@@ -159,6 +159,9 @@ module Data.IntMap.Strict.Internal (
, intersectionWith
, intersectionWithKey
+ -- ** Disjoint
+ , disjoint
+
-- ** Universal combining function
, mergeWithKey
@@ -296,6 +299,7 @@ import Data.IntMap.Internal
, difference
, elems
, intersection
+ , disjoint
, isProperSubmapOf
, isProperSubmapOfBy
, isSubmapOf
diff --git a/containers/src/Data/Map/Internal.hs b/containers/src/Data/Map/Internal.hs
index f68ed717..6f3dcef6 100644
--- a/containers/src/Data/Map/Internal.hs
+++ b/containers/src/Data/Map/Internal.hs
@@ -189,6 +189,9 @@ module Data.Map.Internal (
, intersectionWith
, intersectionWithKey
+ -- ** Disjoint
+ , disjoint
+
-- ** General combining function
, SimpleWhenMissing
, SimpleWhenMatched
@@ -2055,6 +2058,33 @@ intersectionWithKey f (Bin _ k x1 l1 r1) t2 = case mb of
{-# INLINABLE intersectionWithKey #-}
#endif
+{--------------------------------------------------------------------
+ Disjoint
+--------------------------------------------------------------------}
+-- | /O(m*log(n\/m + 1)), m <= n/. Check whether the key sets of two
+-- maps are disjoint (i.e., their 'intersection' is empty).
+--
+-- > disjoint (fromList [(2,'a')]) (fromList [(1,()), (3,())]) == True
+-- > disjoint (fromList [(2,'a')]) (fromList [(1,'a'), (2,'b')]) == False
+-- > disjoint (fromList []) (fromList []) == True
+--
+-- @
+-- xs ``disjoint`` ys = null (xs ``intersection`` ys)
+-- @
+--
+-- @since UNRELEASED
+
+-- See 'Data.Set.Internal.isSubsetOfX' for some background
+-- on the implementation design.
+disjoint :: Ord k => Map k a -> Map k b -> Bool
+disjoint Tip _ = True
+disjoint _ Tip = True
+disjoint (Bin 1 k _ _ _) t = k `notMember` t
+disjoint (Bin _ k _ l r) t
+ = not found && disjoint l lt && disjoint r gt
+ where
+ (lt,found,gt) = splitMember k t
+
#if !MIN_VERSION_base (4,8,0)
-- | The identity type.
newtype Identity a = Identity { runIdentity :: a }
diff --git a/containers/src/Data/Map/Lazy.hs b/containers/src/Data/Map/Lazy.hs
index 1080f96c..37ae931e 100644
--- a/containers/src/Data/Map/Lazy.hs
+++ b/containers/src/Data/Map/Lazy.hs
@@ -163,6 +163,9 @@ module Data.Map.Lazy (
, intersectionWith
, intersectionWithKey
+ -- ** Disjoint
+ , disjoint
+
-- ** General combining functions
-- | See "Data.Map.Merge.Lazy"
diff --git a/containers/src/Data/Map/Strict.hs b/containers/src/Data/Map/Strict.hs
index 084b8567..a7307841 100644
--- a/containers/src/Data/Map/Strict.hs
+++ b/containers/src/Data/Map/Strict.hs
@@ -179,6 +179,9 @@ module Data.Map.Strict
, intersectionWith
, intersectionWithKey
+ -- ** Disjoint
+ , disjoint
+
-- ** General combining functions
-- | See "Data.Map.Merge.Strict"
diff --git a/containers/src/Data/Map/Strict/Internal.hs b/containers/src/Data/Map/Strict/Internal.hs
index 788d51d3..a161b2f4 100644
--- a/containers/src/Data/Map/Strict/Internal.hs
+++ b/containers/src/Data/Map/Strict/Internal.hs
@@ -142,6 +142,9 @@ module Data.Map.Strict.Internal
, intersectionWith
, intersectionWithKey
+ -- ** Disjoint
+ , disjoint
+
-- ** General combining function
, SimpleWhenMissing
, SimpleWhenMatched
@@ -339,6 +342,7 @@ import Data.Map.Internal
, deleteMin
, deleteMax
, difference
+ , disjoint
, drop
, dropWhileAntitone
, filter
--
GitLab