Add symmetric difference ops

...for Set, Map, IntSet, IntMap. This joins the set operations already
implemented: union, intersection, difference.

Author: meooow25

containers-tests/benchmarks/SetOperations/SetOperations-IntMap.hs

@@ -3,4 +3,10 @@ module Main where
 import Data.IntMap as C
 import SetOperations
 
-main = benchmark (\xs -> fromList [(x, x) | x <- xs]) True [("union", C.union), ("difference", C.difference), ("intersection", C.intersection)]
+main :: IO ()
+main = benchmark (\xs -> fromList [(x, x) | x <- xs]) True
+  [ ("union", C.union)
+  , ("difference", C.difference)
+  , ("intersection", C.intersection)
+  , ("symmetricDifference", C.symmetricDifference)
+  ]

containers-tests/benchmarks/SetOperations/SetOperations-IntSet.hs

@@ -3,4 +3,10 @@ module Main where
 import Data.IntSet as C
 import SetOperations
 
-main = benchmark fromList True [("union", C.union), ("difference", C.difference), ("intersection", C.intersection)]
+main :: IO ()
+main = benchmark fromList True
+  [ ("union", C.union)
+  , ("difference", C.difference)
+  , ("intersection", C.intersection)
+  , ("symmetricDifference", C.symmetricDifference)
+  ]

containers-tests/benchmarks/SetOperations/SetOperations-Map.hs

@@ -3,4 +3,10 @@ module Main where
 import Data.Map as C
 import SetOperations
 
-main = benchmark (\xs -> fromList [(x, x) | x <- xs]) True [("union", C.union), ("difference", C.difference), ("intersection", C.intersection)]
+main :: IO ()
+main = benchmark (\xs -> fromList [(x, x) | x <- xs]) True
+  [ ("union", C.union)
+  , ("difference", C.difference)
+  , ("intersection", C.intersection)
+  , ("symmetricDifference", C.symmetricDifference)
+  ]

containers-tests/benchmarks/SetOperations/SetOperations-Set.hs

@@ -3,4 +3,10 @@ module Main where
 import Data.Set as C
 import SetOperations
 
-main = benchmark fromList True [("union", C.union), ("difference", C.difference), ("intersection", C.intersection)]
+main :: IO ()
+main = benchmark fromList True
+  [ ("union", C.union)
+  , ("difference", C.difference)
+  , ("intersection", C.intersection)
+  , ("symmetricDifference", C.symmetricDifference)
+  ]

containers-tests/tests/intmap-properties.hs

@@ -150,6 +150,7 @@ main = defaultMain $ testGroup "intmap-properties"
              , testProperty "intersection model"   prop_intersectionModel
              , testProperty "intersectionWith model" prop_intersectionWithModel
              , testProperty "intersectionWithKey model" prop_intersectionWithKeyModel
+             , testProperty "symmetricDifference"  prop_symmetricDifference
              , testProperty "mergeWithKey model"   prop_mergeWithKeyModel
              , testProperty "merge valid"          prop_merge_valid
              , testProperty "mergeA effects"       prop_mergeA_effects
@@ -1258,6 +1259,17 @@ prop_intersectionWithKeyModel xs ys
           ys' = List.nubBy ((==) `on` fst) ys
           f k l r = k + 2 * l + 3 * r
 
+prop_symmetricDifference :: IMap -> IMap -> Property
+prop_symmetricDifference m1 m2 =
+  valid m3 .&&.
+  toAscList m3 ===
+  List.sort (   List.filter ((`notElem` fmap fst kys) . fst) kxs
+             ++ List.filter ((`notElem` fmap fst kxs) . fst) kys)
+  where
+    m3 = symmetricDifference m1 m2
+    kxs = toAscList m1
+    kys = toAscList m2
+
 prop_disjoint :: UMap -> UMap -> Property
 prop_disjoint m1 m2 = disjoint m1 m2 === null (intersection m1 m2)
 

containers-tests/tests/intset-properties.hs

@@ -42,6 +42,7 @@ main = defaultMain $ testGroup "intset-properties"
                    , testProperty "prop_union" prop_union
                    , testProperty "prop_difference" prop_difference
                    , testProperty "prop_intersection" prop_intersection
+                   , testProperty "prop_symmetricDifference" prop_symmetricDifference
                    , testProperty "prop_Ordered" prop_Ordered
                    , testProperty "prop_List" prop_List
                    , testProperty "prop_DescList" prop_DescList
@@ -264,6 +265,17 @@ prop_intersection xs ys =
       valid t .&&.
       toAscList t === (toAscList xs `List.intersect` toAscList ys)
 
+prop_symmetricDifference :: IntSet -> IntSet -> Property
+prop_symmetricDifference xs ys =
+  case symmetricDifference xs ys of
+    t ->
+      valid t .&&.
+      toAscList t ===
+      List.sort (List.filter (`notElem` xs') ys' ++ List.filter (`notElem` ys') xs')
+    where
+      xs' = toAscList xs
+      ys' = toAscList ys
+
 prop_disjoint :: IntSet -> IntSet -> Bool
 prop_disjoint a b = a `disjoint` b == null (a `intersection` b)
 

containers-tests/tests/map-properties.hs

@@ -178,6 +178,7 @@ main = defaultMain $ testGroup "map-properties"
          , testProperty "intersectionWithModel" prop_intersectionWithModel
          , testProperty "intersectionWithKey"  prop_intersectionWithKey
          , testProperty "intersectionWithKeyModel" prop_intersectionWithKeyModel
+         , testProperty "symmetricDifference"  prop_symmetricDifference
          , testProperty "disjoint"             prop_disjoint
          , testProperty "compose"              prop_compose
          , testProperty "differenceMerge"   prop_differenceMerge
@@ -1168,6 +1169,17 @@ prop_intersectionWithKeyModel xs ys
           ys' = List.nubBy ((==) `on` fst) ys
           f k l r = k + 2 * l + 3 * r
 
+prop_symmetricDifference :: IMap -> IMap -> Property
+prop_symmetricDifference m1 m2 =
+  valid m3 .&&.
+  toAscList m3 ===
+  List.sort (   List.filter ((`notElem` fmap fst kys) . fst) kxs
+             ++ List.filter ((`notElem` fmap fst kxs) . fst) kys)
+  where
+    m3 = symmetricDifference m1 m2
+    kxs = toAscList m1
+    kys = toAscList m2
+
 prop_disjoint :: UMap -> UMap -> Property
 prop_disjoint m1 m2 = disjoint m1 m2 === null (intersection m1 m2)
 

containers-tests/tests/set-properties.hs

@@ -74,6 +74,7 @@ main = defaultMain $ testGroup "set-properties"
                    , testProperty "prop_isProperSubsetOf2" prop_isProperSubsetOf2
                    , testProperty "prop_isSubsetOf" prop_isSubsetOf
                    , testProperty "prop_isSubsetOf2" prop_isSubsetOf2
+                   , testProperty "prop_symmetricDifference" prop_symmetricDifference
                    , testProperty "prop_disjoint" prop_disjoint
                    , testProperty "prop_size" prop_size
                    , testProperty "prop_lookupMax" prop_lookupMax
@@ -487,6 +488,16 @@ prop_Int :: [Int] -> [Int] -> Bool
 prop_Int xs ys = toAscList (intersection (fromList xs) (fromList ys))
                  == List.sort (nub ((List.intersect) (xs)  (ys)))
 
+prop_symmetricDifference :: Set Int -> Set Int -> Property
+prop_symmetricDifference xs ys =
+  valid zs .&&.
+  toAscList zs ===
+  List.sort (List.filter (`notElem` xs') ys' ++ List.filter (`notElem` ys') xs')
+  where
+    zs = symmetricDifference xs ys
+    xs' = toAscList xs
+    ys' = toAscList ys
+
 prop_disjoint :: Set Int -> Set Int -> Bool
 prop_disjoint a b = a `disjoint` b == null (a `intersection` b)
 

containers/src/Data/IntMap/Internal.hs

@@ -125,6 +125,9 @@ module Data.IntMap.Internal (
     , intersectionWith
     , intersectionWithKey
 
+    -- ** Symmetric difference
+    , symmetricDifference
+
     -- ** Compose
     , compose
 
@@ -1304,6 +1307,49 @@ intersectionWithKey :: (Key -> a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
 intersectionWithKey f m1 m2
   = mergeWithKey' bin (\(Tip k1 x1) (Tip _k2 x2) -> Tip k1 (f k1 x1 x2)) (const Nil) (const Nil) m1 m2
 
+{--------------------------------------------------------------------
+  Symmetric difference
+--------------------------------------------------------------------}
+
+-- | \(O(n+m)\). The symmetric difference of two maps.
+--
+-- The result contains entries whose keys appear in exactly one of the two maps.
+--
+-- @
+-- symmetricDifference
+--   (fromList [(0,\'q\'),(2,\'b\'),(4,\'w\'),(6,\'o\')])
+--   (fromList [(0,\'e\'),(3,\'r\'),(6,\'t\'),(9,\'s\')])
+-- ==
+-- fromList [(2,\'b\'),(3,\'r\'),(4,\'w\'),(9,\'s\')]
+-- @
+--
+-- @since FIXME
+symmetricDifference :: IntMap a -> IntMap a -> IntMap a
+symmetricDifference t1@(Bin p1 l1 r1) t2@(Bin p2 l2 r2) =
+  case treeTreeBranch p1 p2 of
+    ABL -> bin p1 (symmetricDifference l1 t2) r1
+    ABR -> bin p1 l1 (symmetricDifference r1 t2)
+    BAL -> bin p2 (symmetricDifference t1 l2) r2
+    BAR -> bin p2 l2 (symmetricDifference t1 r2)
+    EQL -> bin p1 (symmetricDifference l1 l2) (symmetricDifference r1 r2)
+    NOM -> link (unPrefix p1) t1 (unPrefix p2) t2
+symmetricDifference t1@(Bin _ _ _) t2@(Tip k2 _) = symDiffTip t2 k2 t1
+symmetricDifference t1@(Bin _ _ _) Nil = t1
+symmetricDifference t1@(Tip k1 _) t2 = symDiffTip t1 k1 t2
+symmetricDifference Nil t2 = t2
+
+symDiffTip :: IntMap a -> Int -> IntMap a -> IntMap a
+symDiffTip !t1 !k1 = go
+  where
+    go t2@(Bin p2 l2 r2)
+      | nomatch k1 p2 = linkKey k1 t1 p2 t2
+      | left k1 p2 = bin p2 (go l2) r2
+      | otherwise = bin p2 l2 (go r2)
+    go t2@(Tip k2 _)
+      | k1 == k2 = Nil
+      | otherwise = link k1 t1 k2 t2
+    go Nil = t1
+
 {--------------------------------------------------------------------
   MergeWithKey
 --------------------------------------------------------------------}

containers/src/Data/IntMap/Lazy.hs

@@ -142,6 +142,9 @@ module Data.IntMap.Lazy (
     , intersectionWith
     , intersectionWithKey
 
+    -- ** Symmetric difference
+    , symmetricDifference
+
     -- ** Disjoint
     , disjoint
 

containers/src/Data/IntMap/Strict.hs

@@ -161,6 +161,9 @@ module Data.IntMap.Strict (
     , intersectionWith
     , intersectionWithKey
 
+    -- ** Symmetric difference
+    , symmetricDifference
+
     -- ** Disjoint
     , disjoint
 

containers/src/Data/IntMap/Strict/Internal.hs

@@ -161,6 +161,9 @@ module Data.IntMap.Strict.Internal (
     , intersectionWith
     , intersectionWithKey
 
+    -- ** Symmetric difference
+    , symmetricDifference
+
     -- ** Disjoint
     , disjoint
 
@@ -339,6 +342,7 @@ import Data.IntMap.Internal
   , split
   , splitLookup
   , splitRoot
+  , symmetricDifference
   , toAscList
   , toDescList
   , toList

containers/src/Data/IntSet.hs

@@ -108,6 +108,7 @@ module Data.IntSet (
             , difference
             , (\\)
             , intersection
+            , symmetricDifference
 
             -- * Filter
             , IS.filter

containers/src/Data/IntSet/Internal.hs

@@ -125,6 +125,7 @@ module Data.IntSet.Internal (
     , unions
     , difference
     , intersection
+    , symmetricDifference
 
     -- * Filter
     , filter
@@ -656,6 +657,45 @@ intersection (Tip kx1 bm1) t2 = intersectBM t2
 
 intersection Nil _ = Nil
 
+{--------------------------------------------------------------------
+  Symmetric difference
+--------------------------------------------------------------------}
+
+-- | \(O(n+m)\). The symmetric difference of two sets.
+--
+-- The result contains elements that appear in exactly one of the two sets.
+--
+-- @
+-- symmetricDifference (fromList [0,2,4,6]) (fromList [0,3,6,9]) == fromList [2,3,4,9]
+-- @
+--
+-- @since FIXME
+symmetricDifference :: IntSet -> IntSet -> IntSet
+symmetricDifference t1@(Bin p1 l1 r1) t2@(Bin p2 l2 r2) =
+  case treeTreeBranch p1 p2 of
+    ABL -> bin p1 (symmetricDifference l1 t2) r1
+    ABR -> bin p1 l1 (symmetricDifference r1 t2)
+    BAL -> bin p2 (symmetricDifference t1 l2) r2
+    BAR -> bin p2 l2 (symmetricDifference t1 r2)
+    EQL -> bin p1 (symmetricDifference l1 l2) (symmetricDifference r1 r2)
+    NOM -> link (unPrefix p1) t1 (unPrefix p2) t2
+symmetricDifference t1@(Bin _ _ _) t2@(Tip kx2 bm2) = symDiffTip t2 kx2 bm2 t1
+symmetricDifference t1@(Bin _ _ _) Nil = t1
+symmetricDifference t1@(Tip kx1 bm1) t2 = symDiffTip t1 kx1 bm1 t2
+symmetricDifference Nil t2 = t2
+
+symDiffTip :: IntSet -> Int -> BitMap -> IntSet -> IntSet
+symDiffTip !t1 !kx1 !bm1 = go
+  where
+    go t2@(Bin p2 l2 r2)
+      | nomatch kx1 p2 = linkKey kx1 t1 p2 t2
+      | left kx1 p2 = bin p2 (go l2) r2
+      | otherwise = bin p2 l2 (go r2)
+    go t2@(Tip kx2 bm2)
+      | kx1 == kx2 = tip kx1 (bm1 `xor` bm2)
+      | otherwise = link kx1 t1 kx2 t2
+    go Nil = t1
+
 {--------------------------------------------------------------------
   Subset
 --------------------------------------------------------------------}

containers/src/Data/Map/Internal.hs

@@ -186,6 +186,9 @@ module Data.Map.Internal (
     , intersectionWith
     , intersectionWithKey
 
+    -- ** Symmetric difference
+    , symmetricDifference
+
     -- ** Disjoint
     , disjoint
 
@@ -2065,6 +2068,38 @@ intersectionWithKey f (Bin _ k x1 l1 r1) t2 = case mb of
 {-# INLINABLE intersectionWithKey #-}
 #endif
 
+{--------------------------------------------------------------------
+  Symmetric difference
+--------------------------------------------------------------------}
+
+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\).
+-- The symmetric difference of two maps.
+--
+-- The result contains entries whose keys appear in exactly one of the two maps.
+--
+-- @
+-- symmetricDifference
+--   (fromList [(0,\'q\'),(2,\'b\'),(4,\'w\'),(6,\'o\')])
+--   (fromList [(0,\'e\'),(3,\'r\'),(6,\'t\'),(9,\'s\')])
+-- ==
+-- fromList [(2,\'b\'),(3,\'r\'),(4,\'w\'),(9,\'s\')]
+-- @
+--
+-- @since FIXME
+symmetricDifference :: Ord k => Map k a -> Map k a -> Map k a
+symmetricDifference Tip t2 = t2
+symmetricDifference t1 Tip = t1
+symmetricDifference (Bin _ k x l1 r1) t2
+  | found = link2 l1l2 r1r2
+  | otherwise = link k x l1l2 r1r2
+  where
+    !(l2, found, r2) = splitMember k t2
+    !l1l2 = symmetricDifference l1 l2
+    !r1r2 = symmetricDifference r1 r2
+#if __GLASGOW_HASKELL__
+{-# INLINABLE symmetricDifference #-}
+#endif
+
 {--------------------------------------------------------------------
   Disjoint
 --------------------------------------------------------------------}

containers/src/Data/Map/Lazy.hs

@@ -164,6 +164,9 @@ module Data.Map.Lazy (
     , intersectionWith
     , intersectionWithKey
 
+    -- ** Symmetric difference
+    , symmetricDifference
+
     -- ** Disjoint
     , disjoint
 

containers/src/Data/Map/Strict.hs

@@ -180,6 +180,9 @@ module Data.Map.Strict
     , intersectionWith
     , intersectionWithKey
 
+    -- ** Symmetric difference
+    , symmetricDifference
+
     -- ** Disjoint
     , disjoint
 

containers/src/Data/Map/Strict/Internal.hs

@@ -142,6 +142,9 @@ module Data.Map.Strict.Internal
     , intersectionWith
     , intersectionWithKey
 
+    -- ** Symmetric difference
+    , symmetricDifference
+
     -- ** Disjoint
     , disjoint
 
@@ -409,6 +412,7 @@ import Data.Map.Internal
   , splitAt
   , splitLookup
   , splitRoot
+  , symmetricDifference
   , take
   , takeWhileAntitone
   , toList