packages feed

sets 0.0.4.1 → 0.0.5

raw patch · 16 files changed

+781/−46 lines, 16 filesdep +compositiondep +criteriondep +keysdep −discriminationdep ~basedep ~commutativedep ~containers

Dependencies added: composition, criterion, keys, mtl, semigroupoids, semigroups, transformers, transformers-base

Dependencies removed: discrimination

Dependency ranges changed: base, commutative, containers, witherable

Files

+ bench/Data/IntMap/Data.hs view
@@ -0,0 +1,22 @@+module Data.IntMap.Data where++import qualified Data.IntMap as I+++imapTo :: Int -> I.IntMap Int+imapTo n = I.fromList $ [1..n] `zip` [1..n]++imap1 :: I.IntMap Int+imap1 = imapTo 10++imap2 :: I.IntMap Int+imap2 = imapTo 20++imap3 :: I.IntMap Int+imap3 = imapTo 30++imap4 :: I.IntMap Int+imap4 = imapTo 40++imap5 :: I.IntMap Int+imap5 = imapTo 50
+ bench/Data/IntSet/Data.hs view
@@ -0,0 +1,22 @@+module Data.IntSet.Data where++import qualified Data.IntSet as I+++isetTo :: Int -> I.IntSet+isetTo n = I.fromList [1..n]++iset1 :: I.IntSet+iset1 = isetTo 10++iset2 :: I.IntSet+iset2 = isetTo 20++iset3 :: I.IntSet+iset3 = isetTo 30++iset4 :: I.IntSet+iset4 = isetTo 40++iset5 :: I.IntSet+iset5 = isetTo 50
+ bench/Data/Map/Data.hs view
@@ -0,0 +1,22 @@+module Data.Map.Data where++import qualified Data.Map as Map+++mapTo :: Int -> Map.Map Int Int+mapTo n = Map.fromList $ [0..n] `zip` [0..n]++map1 :: Map.Map Int Int+map1 = mapTo 10++map2 :: Map.Map Int Int+map2 = mapTo 20++map3 :: Map.Map Int Int+map3 = mapTo 30++map4 :: Map.Map Int Int+map4 = mapTo 40++map5 :: Map.Map Int Int+map5 = mapTo 50
+ bench/Data/Set/Data.hs view
@@ -0,0 +1,23 @@+module Data.Set.Data where++import qualified Data.Set as Set++++setTo :: Int -> Set.Set Int+setTo n = Set.fromList [1..n]++set1 :: Set.Set Int+set1 = setTo 10++set2 :: Set.Set Int+set2 = setTo 20++set3 :: Set.Set Int+set3 = setTo 30++set4 :: Set.Set Int+set4 = setTo 40++set5 :: Set.Set Int+set5 = setTo 50
+ bench/Data/Set/Ordered/Many/Data.hs view
@@ -0,0 +1,24 @@+module Data.Set.Ordered.Many.Data where++import qualified Data.Set.Ordered.Many as OM+import Data.Set.Class++++omsetTo :: Int -> OM.OMSet Int+omsetTo n = fromFoldable [1..n]++omset1 :: OM.OMSet Int+omset1 = omsetTo 10++omset2 :: OM.OMSet Int+omset2 = omsetTo 20++omset3 :: OM.OMSet Int+omset3 = omsetTo 30++omset4 :: OM.OMSet Int+omset4 = omsetTo 40++omset5 :: OM.OMSet Int+omset5 = omsetTo 50
+ bench/Data/Set/Unordered/Many/Data.hs view
@@ -0,0 +1,24 @@+module Data.Set.Unordered.Many.Data where++import qualified Data.Set.Unordered.Many as UM+import Data.Set.Class++++umsetTo :: Int -> UM.UMSet Int+umsetTo n = fromFoldable [1..n]++umset1 :: UM.UMSet Int+umset1 = umsetTo 10++umset2 :: UM.UMSet Int+umset2 = umsetTo 20++umset3 :: UM.UMSet Int+umset3 = umsetTo 30++umset4 :: UM.UMSet Int+umset4 = umsetTo 40++umset5 :: UM.UMSet Int+umset5 = umsetTo 50
+ bench/Data/Set/Unordered/Unique/Data.hs view
@@ -0,0 +1,24 @@+module Data.Set.Unordered.Unique.Data where++import qualified Data.Set.Unordered.Unique as UU+import Data.Set.Class++++uusetTo :: Int -> UU.UUSet Int+uusetTo n = fromFoldable [1..n]++uuset1 :: UU.UUSet Int+uuset1 = uusetTo 10++uuset2 :: UU.UUSet Int+uuset2 = uusetTo 20++uuset3 :: UU.UUSet Int+uuset3 = uusetTo 30++uuset4 :: UU.UUSet Int+uuset4 = uusetTo 40++uuset5 :: UU.UUSet Int+uuset5 = uusetTo 50
+ bench/Profile.hs view
@@ -0,0 +1,143 @@+module Main where++import Data.Set.Class as Sets++import qualified Data.Set as Set+import qualified Data.Map as Map+import qualified Data.Sequence as Seq+import qualified Data.IntSet as IntSet+import qualified Data.IntMap as IntMap+import qualified Data.List as List+import qualified Data.HashSet as HashSet+import qualified Data.HashMap.Lazy as HashMap+import qualified Data.Functor.Contravariant as Pred+import qualified Data.Set.Ordered.Many as OM+import qualified Data.Set.Unordered.Many as UM+import qualified Data.Set.Unordered.Unique as UU+import qualified Data.Set.Ordered.Unique.Finite as OUF+import qualified Data.Set.Ordered.Unique.With as SetWith+import qualified Data.Set.Ordered.Many.With as SetsWith++import Data.Monoid+import Data.Commutative++import Criterion.Main+import Data.Set.Data+import Data.Map.Data+import Data.IntSet.Data+import Data.IntMap.Data+import Data.Set.Ordered.Many.Data+import Data.Set.Unordered.Many.Data+import Data.Set.Unordered.Unique.Data+++main :: IO ()+main = defaultMain+  [ bgroup "Union"+    [ bgroup "`Data.Set`" $+        benchUnion set1 [set1,set2,set3,set4,set5]+    , bgroup "`Data.Map`" $+        benchUnion map1 [map1,map2,map3,map4,map5]+    , bgroup "`Data.IntSet`" $+        benchUnion iset1 [iset1,iset2,iset3,iset4,iset5]+    , bgroup "`Data.IntMap`" $+        benchUnion imap1 [imap1,imap2,imap3,imap4,imap5]+    , bgroup "`Data.Set.Ordered.Many`" $+        benchUnion omset1 [omset1,omset2,omset3,omset4,omset5]+    , bgroup "`Data.Set.Unordered.Many`" $+        benchUnion umset1 [umset1,umset2,umset3,umset4,umset5]+    , bgroup "`Data.Set.Unordered.Unique`" $+        benchUnion uuset1 [uuset1,uuset2,uuset3,uuset4,uuset5]+    ]+  , bgroup "Intersection"+    [ bgroup "`Data.Set`" $+        benchIntersection set1 [set1,set2,set3,set4,set5]+    , bgroup "`Data.Map`" $+        benchIntersection map1 [map1,map2,map3,map4,map5]+    , bgroup "`Data.IntSet`" $+        benchIntersection iset1 [iset1,iset2,iset3,iset4,iset5]+    , bgroup "`Data.IntMap`" $+        benchIntersection imap1 [imap1,imap2,imap3,imap4,imap5]+    , bgroup "`Data.Set.Ordered.Many`" $+        benchIntersection omset1 [omset1,omset2,omset3,omset4,omset5]+    , bgroup "`Data.Set.Unordered.Many`" $+        benchIntersection umset1 [umset1,umset2,umset3,umset4,umset5]+    , bgroup "`Data.Set.Unordered.Unique`" $+        benchIntersection uuset1 [uuset1,uuset2,uuset3,uuset4,uuset5]+    ]+  , bgroup "Difference"+    [ bgroup "`Data.Set`" $+        benchDifference set1 [set1,set2,set3,set4,set5]+    , bgroup "`Data.Map`" $+        benchDifference map1 [map1,map2,map3,map4,map5]+    , bgroup "`Data.IntSet`" $+        benchDifference iset1 [iset1,iset2,iset3,iset4,iset5]+    , bgroup "`Data.IntMap`" $+        benchDifference imap1 [imap1,imap2,imap3,imap4,imap5]+    , bgroup "`Data.Set.Ordered.Many`" $+        benchDifference omset1 [omset1,omset2,omset3,omset4,omset5]+    , bgroup "`Data.Set.Unordered.Many`" $+        benchDifference umset1 [umset1,umset2,umset3,umset4,umset5]+    , bgroup "`Data.Set.Unordered.Unique`" $+        benchDifference uuset1 [uuset1,uuset2,uuset3,uuset4,uuset5]+    ]+  , bgroup "Insert"+    [ bgroup "`Data.Set`" $+        benchInsert set5 ([10,20,30,40,50] :: [Int])+    , bgroup "`Data.IntSet`" $+        benchInsert iset5 ([10,20,30,40,50] :: [Int])+    , bgroup "`Data.Set.Ordered.Many`" $+        benchInsert omset5 ([10,20,30,40,50] :: [Int])+    , bgroup "`Data.Set.Unordered.Many`" $+        benchInsert umset5 ([10,20,30,40,50] :: [Int])+    , bgroup "`Data.Set.Unordered.Unique`" $+        benchInsert uuset5 ([10,20,30,40,50] :: [Int])+    ]+  , bgroup "Delete"+    [ bgroup "`Data.Set`" $+        benchDelete set5 ([10,20,30,40,50] :: [Int])+    , bgroup "`Data.IntSet`" $+        benchDelete iset5 ([10,20,30,40,50] :: [Int])+    , bgroup "`Data.Set.Ordered.Many`" $+        benchDelete omset5 ([10,20,30,40,50] :: [Int])+    , bgroup "`Data.Set.Unordered.Many`" $+        benchDelete umset5 ([10,20,30,40,50] :: [Int])+    , bgroup "`Data.Set.Unordered.Unique`" $+        benchDelete uuset5 ([10,20,30,40,50] :: [Int])+    ]+  ]+++benchBin :: String -> (s -> s -> s) -> s -> [s] -> [Benchmark]+benchBin name bin s1 ss =+  [ bgroup (name ++ " xs")+    [ bench (show k) $ whnf (`bin` s1) s+          | (k,s) <- [(1 :: Int)..] `zip` ss+          ]+  , bgroup ("xs " ++ name)+    [ bench (show k) $ whnf (s1 `bin`) s+          | (k,s) <- [(1 :: Int)..] `zip` ss+          ]+  ]++benchUnion :: HasUnion s => s -> [s] -> [Benchmark]+benchUnion = benchBin "`union`" Sets.union++benchIntersection :: HasIntersection s => s -> [s] -> [Benchmark]+benchIntersection = benchBin "`intersection`" Sets.intersection++benchDifference :: HasDifference s => s -> [s] -> [Benchmark]+benchDifference = benchBin "`difference`" Sets.difference+++benchElem :: (a -> s -> s) -> s -> [a] -> [Benchmark]+benchElem act s0 ss =+  [ bench (show k) $ whnf (`act` s0) s+        | (k,s) <- [(1 :: Int)..] `zip` ss+        ]++benchInsert :: HasInsert a s => s -> [a] -> [Benchmark]+benchInsert = benchElem Sets.insert++benchDelete :: HasDelete a s => s -> [a] -> [Benchmark]+benchDelete = benchElem Sets.delete
sets.cabal view
@@ -1,10 +1,10 @@ Name:                   sets-Version:                0.0.4.1+Version:                0.0.5 Author:                 Athan Clark <athan.clark@gmail.com> Maintainer:             Athan Clark <athan.clark@gmail.com> License:                MIT License-File:           LICENSE-Synopsis:               Various set implementations in Haskell+Synopsis:               Various set implementations in Haskell. Description:            This also includes overloaded functions for common set operations. See @Data.Set.Class@. Cabal-Version:          >= 1.10 Build-Type:             Simple@@ -26,19 +26,34 @@                       , containers                       , unordered-containers                       , hashable-                      , commutative+                      , commutative >= 0.0.1.4+                      , composition                       , contravariant-                      , discrimination                       , invariant                       , witherable+                      , keys+                      , semigroups+                      , semigroupoids+                      , mtl+                      , transformers+                      , transformers-base+                      , QuickCheck  Test-Suite spec   Type:                 exitcode-stdio-1.0   Default-Language:     Haskell2010   Hs-Source-Dirs:       src                       , test-  Ghc-Options:          -Wall+  Ghc-Options:          -Wall -threaded   Main-Is:              Main.hs+  Other-Modules:        Data.SetSpec+                        Data.Set.Class+                        Data.Set.Ordered.Many+                        Data.Set.Ordered.Many.With+                        Data.Set.Ordered.Unique.Finite+                        Data.Set.Ordered.Unique.With+                        Data.Set.Unordered.Many+                        Data.Set.Unordered.Unique   Build-Depends:        base                       , tasty                       , tasty-quickcheck@@ -49,10 +64,55 @@                       , unordered-containers                       , hashable                       , commutative+                      , composition                       , contravariant-                      , discrimination+                      , semigroups+                      , semigroupoids+                      , keys                       , invariant                       , witherable+                      , mtl+                      , transformers+                      , transformers-base+++Benchmark bench+  Type:                 exitcode-stdio-1.0+  Default-Language:     Haskell2010+  Hs-Source-Dirs:       src+                      , bench+  Ghc-Options:          -Wall -threaded+  Main-Is:              Profile.hs+  Other-Modules:        Data.Set.Class+                        Data.Set.Ordered.Many+                        Data.Set.Ordered.Unique.Finite+                        Data.Set.Ordered.Unique.With+                        Data.Set.Unordered.Many+                        Data.Set.Unordered.Unique+                        Data.Set.Data+                        Data.Map.Data+                        Data.IntSet.Data+                        Data.IntMap.Data+                        Data.Set.Ordered.Many.Data+                        Data.Set.Unordered.Many.Data+                        Data.Set.Unordered.Unique.Data+  Build-Depends:        base+                      , QuickCheck+                      , containers+                      , unordered-containers+                      , hashable+                      , commutative+                      , composition+                      , contravariant+                      , invariant+                      , witherable+                      , semigroups+                      , semigroupoids+                      , keys+                      , mtl+                      , transformers+                      , transformers-base+                      , criterion  Source-Repository head   Type:                 git
src/Data/Set/Class.hs view
@@ -6,6 +6,9 @@   , FlexibleContexts   , GeneralizedNewtypeDeriving   , StandaloneDeriving+  , DeriveFunctor+  , DeriveFoldable+  , DeriveTraversable   #-}  -- | Convenience operators overloaded for arbitrary use.@@ -15,10 +18,15 @@ module Data.Set.Class where  import Prelude ( Eq (..), Ord (..), Int, Bool (..), (&&), (||), ($), (.), not, const-               , Show (..))+               , Show (..), Functor (..)) import Data.Foldable as Fold+import Data.Traversable+import Data.Semigroup.Foldable as Fold1+import Data.Semigroup import Data.Monoid as Monoid+import Data.Key import Data.Commutative as Comm+import Data.Composition  import qualified Data.Set as Set import qualified Data.Map as Map@@ -31,75 +39,132 @@ import qualified Data.HashMap.Lazy as HashMap import qualified Data.Functor.Contravariant as Pred import qualified Data.Set.Ordered.Many as OM-import Data.Discrimination as Disc import qualified Data.Set.Unordered.Many as UM import qualified Data.Set.Unordered.Unique as UU import qualified Data.Set.Ordered.Unique.Finite as OUF import qualified Data.Set.Ordered.Unique.With as SetWith  -newtype Union a        = Union {unUnion :: a}-  deriving (Show, Eq)-newtype Intersection a = Intersection {unIntersection :: a}-  deriving (Show, Eq)-newtype XUnion a       = XUnion {unXUnion :: a}-  deriving (Show, Eq) +++-- * Union+ class HasUnion s where   union :: s -> s -> s  unions :: ( Fold.Foldable f-          , HasUnion s-          , HasEmpty s+          , Monoid (Union s)           ) => f s -> s-unions = foldr Data.Set.Class.union empty+unions = unUnion . foldMap Union +unions1 :: ( Fold1.Foldable1 f+           , Semigroup (Union s)+           ) => f s -> s+unions1 = unUnion . foldMap1 Union+++newtype Union a = Union {unUnion :: a}+  deriving ( Show     , Eq+           , Ord      , Functor+           , Foldable , Traversable+           )+ instance HasUnion s => Commutative (Union s) where   commute = union -instance (HasUnion s, HasEmpty s) => Monoid.Monoid (Union s) where+instance (HasUnion s, HasEmpty s) => Monoid (Union s) where   mappend = union   mempty = empty -class HasDifference s where-  difference :: s -> s -> s+instance (HasUnion s) => Semigroup (Union s) where+  (<>) = union -(\\) :: HasDifference s => s -> s -> s-(\\) = difference +-- * Intersection+ class HasIntersection s where   intersection :: s -> s -> s  intersections :: ( Fold.Foldable f-                 , HasIntersection s-                 , HasTotal s+                 , Monoid (Intersection s)                  ) => f s -> s-intersections = foldr Data.Set.Class.intersection total+intersections = unIntersection . foldMap Intersection +intersections1 :: ( Fold1.Foldable1 f+                  , Semigroup (Intersection s)+                  ) => f s -> s+intersections1 = unIntersection . foldMap1 Intersection+++newtype Intersection a = Intersection {unIntersection :: a}+  deriving ( Show     , Eq+           , Ord      , Functor+           , Foldable , Traversable+           )+ instance HasIntersection s => Commutative (Intersection s) where   commute = intersection -instance (HasIntersection s, HasTotal s) => Monoid.Monoid (Intersection s) where+instance (HasIntersection s, HasTotal s) => Monoid (Intersection s) where   mappend = intersection   mempty = total +instance (HasIntersection s) => Semigroup (Intersection s) where+  (<>) = intersection+++-- ** Difference++class HasDifference s where+  difference :: s -> s -> s++(\\) :: HasDifference s => s -> s -> s+(\\) = difference+++-- ** Exclusive Union / Symmetric Difference+ class HasXUnion s where   xunion :: s -> s -> s +xunions :: ( Fold.Foldable f+           , Monoid (XUnion s)+           ) => f s -> s+xunions = unXUnion . foldMap XUnion++xunions1 :: ( Fold1.Foldable1 f+            , Semigroup (XUnion s)+            ) => f s -> s+xunions1 = unXUnion . foldMap1 XUnion+++newtype XUnion a = XUnion {unXUnion :: a}+  deriving ( Show     , Eq+           , Ord      , Functor+           , Foldable , Traversable+           )+ instance (HasUnion s, HasIntersection s, HasDifference s) => HasXUnion s where   xunion x y = union x y `difference` intersection x y  instance (HasXUnion s, HasUnion s, HasIntersection s, HasDifference s) => Commutative (XUnion s) where   commute = xunion -instance (HasXUnion s, HasEmpty s, HasUnion s, HasIntersection s, HasDifference s) => Monoid.Monoid (XUnion s) where+instance (HasXUnion s, HasEmpty s, HasUnion s, HasIntersection s, HasDifference s) => Monoid (XUnion s) where   mappend = xunion   mempty = empty +instance (HasXUnion s, HasUnion s, HasIntersection s, HasDifference s) => Semigroup (XUnion s) where+  (<>) = xunion +-- ** Complement+ class HasComplement s where   complement :: s -> s +-- * Per-Element+ class HasSingleton a s where   singleton :: a -> s @@ -115,6 +180,8 @@ class HasInsertWith k a s where   insertWith :: k -> a -> s -> s +-- * Top and Bottom Elements+ class HasEmpty s where   empty :: s @@ -133,9 +200,13 @@ class HasTotalWith k s where   totalWith :: k -> s +-- ** Size+ class HasSize s where   size :: s -> Int +-- * Relation+ class CanBeSubset s where   isSubsetOf :: s -> s -> Bool @@ -143,6 +214,33 @@   isProperSubsetOf :: s -> s -> Bool  +-- * Generic Builders++fromFoldable :: ( Fold.Foldable f+                , HasInsert a s+                , HasEmpty s+                ) => f a -> s+fromFoldable = foldr insert empty++fromFoldableWithKey :: ( FoldableWithKey f+                       , HasInsertWith (Key f) a s+                       , HasEmpty s+                       ) => f a -> s+fromFoldableWithKey = foldrWithKey insertWith empty++fromFoldable1 :: ( Fold1.Foldable1 f+                 , HasSingleton a s+                 , Semigroup (Union s)+                 ) => f a -> s+fromFoldable1 = unUnion . foldMap1 (Union . singleton)++fromFoldable1WithKey :: ( FoldableWithKey1 f+                        , HasSingletonWith (Key f) a s+                        , Semigroup (Union s)+                        ) => f a -> s+fromFoldable1WithKey = unUnion . foldMapWithKey1 (Union .* singletonWith)++ -- Instances  -- Inherit@@ -462,7 +560,7 @@   -- Data.Set.Ordered.Many-instance Disc.Sorting a => HasUnion (OM.OMSet a) where+instance Ord a => HasUnion (OM.OMSet a) where   union = OM.union  instance Eq a => HasDifference (OM.OMSet a) where
src/Data/Set/Ordered/Many.hs view
@@ -3,6 +3,8 @@   , DeriveFunctor   , DeriveFoldable   , DeriveTraversable+  , FlexibleContexts+  , MultiParamTypeClasses   #-}  module Data.Set.Ordered.Many where@@ -11,11 +13,15 @@ import Data.List as List hiding (delete) import Data.Foldable as Fold import Data.Traversable-import Data.Discrimination as Disc import Data.Maybe (fromJust, isJust, mapMaybe)+import Control.Applicative import Control.Monad.Fix+import Control.Monad.State+import Control.Monad.Base +import Test.QuickCheck + -- | Ordered sets with duplicate elements. newtype OMSet a = OMSet {unOMSet :: [a]}   deriving ( Eq@@ -31,6 +37,25 @@ instance Mergeable OMSet where   mergeMap f (OMSet xs) = mergeMap f xs ++instance MonadBase Gen Gen where+  liftBase = id++instance (Arbitrary a, Ord a) => Arbitrary (OMSet a) where+  arbitrary = OMSet <$> sized go+    where+      go s = evalStateT (replicateM s go') Nothing+      go' :: ( MonadState (Maybe a) m+             , MonadBase Gen m+             , Ord a+             , Arbitrary a+             ) => m a+      go' = do+        mprev <- get+        x <- liftBase $ maybe arbitrary (\p -> arbitrary `suchThat` (>= p)) mprev+        put $ Just x+        return x+ -- * Operators  (\\) :: Eq a => OMSet a -> OMSet a -> OMSet a@@ -64,14 +89,14 @@  -- | /O(n*m)/ isSubsetOf :: Eq a => OMSet a -> OMSet a -> Bool-isSubsetOf (OMSet xs) (OMSet ys) = foldr go True xs+isSubsetOf (OMSet xs) (OMSet ys) = List.foldr go True xs   where     go x b | List.elem x ys = b            | otherwise      = False  -- | /O(n*(m^3))/ isProperSubsetOf :: Eq a => OMSet a -> OMSet a -> Bool-isProperSubsetOf (OMSet xs) (OMSet ys) = fst $ foldr go (True,ys) xs+isProperSubsetOf (OMSet xs) (OMSet ys) = fst $ List.foldr go (True,ys) xs   where     go _ (False,soFar) = (False,soFar)     go _ (_,[]) = (False,[])@@ -94,8 +119,8 @@ insert x (OMSet xs) = OMSet $ insert' x xs   where     insert' x' [] = [x']-    insert' x' (a:as) | x' > a = a : insert' x' as-                      | otherwise = x':a:as+    insert' x' (a:as) | x' <= a   = x': a:as+                      | otherwise = a : insert' x' as  -- | /O(n)/ delete :: Eq a => a -> OMSet a -> OMSet a@@ -103,20 +128,25 @@  -- * Combine --- | /O(n+m)/-union :: Disc.Sorting a => OMSet a -> OMSet a -> OMSet a-union (OMSet xs) (OMSet ys) = OMSet $ Disc.sort (xs ++ ys)+-- | /O(min n m)/+union :: Ord a => OMSet a -> OMSet a -> OMSet a+union (OMSet xs') (OMSet ys') = OMSet $ go xs' ys'+  where+    go [] ys = ys+    go xs [] = xs+    go (x:xs) (y:ys) | x <= y    = x : go xs (y:ys)+                     | otherwise = y : go (x:xs) ys  -- | /O(n*m)/ difference :: Eq a => OMSet a -> OMSet a -> OMSet a-difference (OMSet xs) (OMSet ys) = OMSet $ foldr go [] xs+difference (OMSet xs) (OMSet ys) = OMSet $ List.foldr go [] xs  where    go x soFar | List.elem x ys =   soFar               | otherwise      = x:soFar  -- | /O(min(n,m))/ - Combines all elements of both intersection :: Ord a => OMSet a -> OMSet a -> OMSet a-intersection (OMSet xs) (OMSet ys) = OMSet $ go xs ys+intersection (OMSet xs') (OMSet ys') = OMSet $ go xs' ys'   where     go [] _ = []     go _ [] = []
src/Data/Set/Ordered/Many/With.hs view
@@ -19,7 +19,7 @@ import Data.Monoid import Data.Maybe (isJust) import Data.Functor.Invariant-import Data.Foldable as Fold+import Data.Foldable as Fold hiding (and) import Control.Applicative hiding (empty)
src/Data/Set/Ordered/Unique/With.hs view
@@ -13,7 +13,7 @@  module Data.Set.Ordered.Unique.With where -import Prelude (Show, String, Eq, Ord, Bool, Int, Maybe, fmap, not, fst, snd, zip, (.), ($))+import Prelude (Show, String, Eq, Ord, Bool, Int, Maybe, fmap, not, fst, snd, zip, (.), ($), foldr) import qualified Data.Map as Map import qualified Data.List as List import Data.Maybe (isJust)@@ -199,7 +199,7 @@ toList (SetWith (f,xs)) = (f, Map.elems xs)  fromList :: (Ord k, Fold.Foldable f) => (a -> k) -> f a -> SetWith k a-fromList f = List.foldr insert $ empty f+fromList f = Fold.foldr insert $ empty f  -- * Ordered List
src/Data/Set/Unordered/Many.hs view
@@ -9,8 +9,12 @@ import Data.List as List hiding (delete) import qualified Data.List as List import Data.Maybe (fromJust, isJust, mapMaybe)+import Control.Applicative+import Control.Monad +import Test.QuickCheck + -- | Unordered sets with duplicate elements. The semantics for "unordering" is based on the idea -- that we will not know what order the elements are in at any point, and we -- are free to re-order elements in any way.@@ -33,6 +37,11 @@       go _ (Just []) = Nothing       go y (Just xs') | y `elem` xs' = Just $ List.delete y xs'                       | otherwise = Nothing++instance Arbitrary a => Arbitrary (UMSet a) where+  arbitrary = UMSet <$> sized go+    where+      go s = replicateM s arbitrary  -- * Operators
src/Data/Set/Unordered/Unique.hs view
@@ -1,6 +1,8 @@ {-# LANGUAGE     GeneralizedNewtypeDeriving   , DeriveFunctor+  , FlexibleContexts+  , MultiParamTypeClasses   #-}  -- | Unique, unordered sets. The semantics for "unordering" is based on the idea@@ -12,8 +14,13 @@ import Data.Mergeable import Data.List as List import Data.Maybe (fromJust, isJust, mapMaybe)+import Control.Monad.State+import Control.Monad.Base+import Control.Applicative +import Test.QuickCheck + -- | Pronounced "Unordered Unique Set" newtype UUSet a = UUSet {unUUSet :: [a]}   deriving (Functor, Show)@@ -31,6 +38,23 @@       go y (Just xs') | y `elem` xs' = Just $ List.delete y xs'                       | otherwise = Nothing +instance MonadBase Gen Gen where+  liftBase = id++instance (Arbitrary a, Eq a) => Arbitrary (UUSet a) where+  arbitrary = UUSet <$> sized go+    where go s = evalStateT (replicateM s go') []+          go' :: ( MonadState [a] m+                , MonadBase Gen m+                , Eq a+                , Arbitrary a+                ) => m a+          go' = do+            soFar <- get+            x <- liftBase $ arbitrary `suchThat` (`notElem` soFar)+            put $ x:soFar+            return x+ -- * Operators  (\\) :: Eq a => UUSet a -> UUSet a -> UUSet a@@ -56,7 +80,7 @@  -- | /O(n)/ lookup :: Eq a => a -> UUSet a -> Maybe a-lookup x (UUSet xs) = lookup' x xs+lookup x' (UUSet xs') = lookup' x' xs'   where     lookup' _ [] = Nothing     lookup' x (y:ys) | x == y    = Just y@@ -71,7 +95,7 @@  -- | /O(n*(m^2))/ isProperSubsetOf :: Eq a => UUSet a -> UUSet a -> Bool-isProperSubsetOf (UUSet xs) (UUSet ys) = fst $ foldr go (True,ys) xs+isProperSubsetOf (UUSet xs') (UUSet ys') = fst $ foldr go (True,ys') xs'   where     go _ (False,xs) = (False,xs)     go _ (_,[]) = (False,[])@@ -93,7 +117,7 @@  -- | /O(n)/ insert :: Eq a => a -> UUSet a -> UUSet a-insert x (UUSet xs) = UUSet $ insert' x xs+insert x' (UUSet xs) = UUSet $ insert' x' xs   where     insert' x [] = [x]     insert' x (y:ys) | x == y    = y:ys@@ -101,9 +125,9 @@  -- | /O(n)/ delete :: Eq a => a -> UUSet a -> UUSet a-delete x (UUSet xs) = UUSet $ delete' x xs+delete x' (UUSet xs) = UUSet $ delete' x' xs   where-    delete' x [] = []+    delete' _ [] = []     delete' x (y:ys) | x == y    =   ys                      | otherwise = y:delete' x ys
+ test/Data/SetSpec.hs view
@@ -0,0 +1,210 @@+module Data.SetSpec (spec) where++import Data.Set.Class++import Prelude hiding (foldr)+import Test.Tasty+import Test.Tasty.QuickCheck as QC+import Test.QuickCheck+import Test.QuickCheck.Instances++import qualified Data.Set as Set+import qualified Data.Map as Map+import qualified Data.Sequence as Seq+import qualified Data.IntSet as IntSet+import qualified Data.IntMap as IntMap+import qualified Data.List as List+import qualified Data.HashSet as HashSet+import qualified Data.HashMap.Lazy as HashMap+import qualified Data.Functor.Contravariant as Pred+import qualified Data.Set.Ordered.Many as OM+import qualified Data.Set.Unordered.Many as UM+import qualified Data.Set.Unordered.Unique as UU+import qualified Data.Set.Ordered.Unique.Finite as OUF+import qualified Data.Set.Ordered.Unique.With as SetWith+import qualified Data.Set.Ordered.Many.With as SetsWith++import Data.Monoid+import Data.Maybe+import Data.Foldable+import Data.Commutative+import Control.Applicative+import Control.Monad+++spec :: [TestTree]+spec =+  [ testGroup "Union"+    [ testGroup "is associative"+      [ QC.testProperty "`Data.Set`"                  assUnionSet+      , QC.testProperty "`Data.Map`"                  assUnionMap+      , QC.testProperty "`Data.IntSet`"               assUnionIntSet+      , QC.testProperty "`Data.IntMap`"               assUnionIntMap+      , QC.testProperty "`Data.HashSet`"              assUnionHashSet+      , QC.testProperty "`Data.HashMap`"              assUnionHashMap+      , QC.testProperty "`Data.Set.Ordered.Many`"     assUnionOMSet -- FIXME: Dead x_x+      , QC.testProperty "`Data.Set.Unordered.Many`"   assUnionUMSet+      , QC.testProperty "`Data.Set.Unordered.Unique`" assUnionUUSet+      ]+    , testGroup "is commutative"+      [ QC.testProperty "`Data.Set`"                  comUnionSet+      , QC.testProperty "`Data.IntSet`"               comUnionIntSet+      , QC.testProperty "`Data.HashSet`"              comUnionHashSet+      , QC.testProperty "`Data.Set.Ordered.Many`"     comUnionOMSet+      , QC.testProperty "`Data.Set.Unordered.Many`"   comUnionUMSet+      ]+    ]+  , testGroup "Intersection"+    [ testGroup "is commutative"+      [ QC.testProperty "`Data.Set`"                  comIntersectionSet+      , QC.testProperty "`Data.IntSet`"               comIntersectionIntSet+      , QC.testProperty "`Data.HashSet`"              comIntersectionHashSet+      , QC.testProperty "`Data.Set.Ordered.Many`"     comIntersectionOMSet+      ]+    ]+  , testGroup "Symmetric Difference"+    [ testGroup "is associative"+      [ QC.testProperty "`Data.Set`"                  assXUnionSet+      , QC.testProperty "`Data.IntSet`"               assXUnionIntSet+      , QC.testProperty "`Data.HashSet`"              assXUnionHashSet+      ]+    , testGroup "is commutative"+      [ QC.testProperty "`Data.Set`"                  comXUnionSet+      , QC.testProperty "`Data.Map`"                  comXUnionMap+      , QC.testProperty "`Data.IntSet`"               comXUnionIntSet+      , QC.testProperty "`Data.IntMap`"               comXUnionIntMap+      , QC.testProperty "`Data.HashSet`"              comXUnionHashSet+      , QC.testProperty "`Data.HashMap`"              comXUnionHashMap+      , QC.testProperty "`Data.Set.Ordered.Many`"     comXUnionOMSet+      , QC.testProperty "`Data.Set.Unordered.Many`"   comXUnionUMSet+      ]+    ]+  , testGroup "Uniqueness"+    [ testGroup "Union"+      [ QC.testProperty "`Data.Set.Unordered.Unique`"   uniqueUnionUUSet+      ]+    , testGroup "Intersection"+      [ QC.testProperty "`Data.Set.Unordered.Unique`"   uniqueIntersectionUUSet+      ]+    , testGroup "Difference"+      [ QC.testProperty "`Data.Set.Unordered.Unique`"   uniqueDifferenceUUSet+      ]+    ]+  , testGroup "Ordered"+    [ testGroup "Union"+      [ QC.testProperty "`Data.Set.Ordered.Many`" orderedUnionOMSet+      ]+    ]+  ]+  where+    assUnionSet :: Union (Set.Set Int) -> Union (Set.Set Int) -> Union (Set.Set Int) -> Bool+    assUnionSet = associates+    assUnionMap :: Union (Map.Map Int Int) -> Union (Map.Map Int Int) -> Union (Map.Map Int Int) -> Bool+    assUnionMap = associates+    assUnionIntSet :: Union IntSet.IntSet -> Union IntSet.IntSet -> Union IntSet.IntSet -> Bool+    assUnionIntSet = associates+    assUnionIntMap :: Union (IntMap.IntMap Int) -> Union (IntMap.IntMap Int) -> Union (IntMap.IntMap Int) -> Bool+    assUnionIntMap = associates+    assUnionHashSet :: Union (HashSet.HashSet Int) -> Union (HashSet.HashSet Int) -> Union (HashSet.HashSet Int) -> Bool+    assUnionHashSet = associates+    assUnionHashMap :: Union (HashMap.HashMap Int Int) -> Union (HashMap.HashMap Int Int) -> Union (HashMap.HashMap Int Int) -> Bool+    assUnionHashMap = associates+    assUnionOMSet :: Union (OM.OMSet Int) -> Union (OM.OMSet Int) -> Union (OM.OMSet Int) -> Bool+    assUnionOMSet = associates+    assUnionUMSet :: Union (UM.UMSet Int) -> Union (UM.UMSet Int) -> Union (UM.UMSet Int) -> Bool+    assUnionUMSet = associates+    assUnionUUSet :: Union (UU.UUSet Int) -> Union (UU.UUSet Int) -> Union (UU.UUSet Int) -> Bool+    assUnionUUSet = associates++    comUnionSet :: Union (Set.Set Int) -> Union (Set.Set Int) -> Bool+    comUnionSet = commutes+    comUnionIntSet :: Union IntSet.IntSet -> Union IntSet.IntSet -> Bool+    comUnionIntSet = commutes+    comUnionHashSet :: Union (HashSet.HashSet Int) -> Union (HashSet.HashSet Int) -> Bool+    comUnionHashSet = commutes+    comUnionOMSet :: Union (OM.OMSet Int) -> Union (OM.OMSet Int) -> Bool+    comUnionOMSet = commutes+    comUnionUMSet :: Union (UM.UMSet Int) -> Union (UM.UMSet Int) -> Bool+    comUnionUMSet = commutes++    comIntersectionSet :: Intersection (Set.Set Int) -> Intersection (Set.Set Int) -> Bool+    comIntersectionSet = commutes+    comIntersectionIntSet :: Intersection IntSet.IntSet -> Intersection IntSet.IntSet -> Bool+    comIntersectionIntSet = commutes+    comIntersectionHashSet :: Intersection (HashSet.HashSet Int) -> Intersection (HashSet.HashSet Int) -> Bool+    comIntersectionHashSet = commutes+    comIntersectionOMSet :: Intersection (OM.OMSet Int) -> Intersection (OM.OMSet Int) -> Bool+    comIntersectionOMSet = commutes+    comIntersectionUMSet :: Intersection (UM.UMSet Int) -> Intersection (UM.UMSet Int) -> Bool+    comIntersectionUMSet = commutes+    comIntersectionUUSet :: Intersection (UU.UUSet Int) -> Intersection (UU.UUSet Int) -> Bool+    comIntersectionUUSet = commutes++    assXUnionSet :: XUnion (Set.Set Int) -> XUnion (Set.Set Int) -> XUnion (Set.Set Int) -> Bool+    assXUnionSet = associates+    assXUnionIntSet :: XUnion IntSet.IntSet -> XUnion IntSet.IntSet -> XUnion IntSet.IntSet -> Bool+    assXUnionIntSet = associates+    assXUnionHashSet :: XUnion (HashSet.HashSet Int) -> XUnion (HashSet.HashSet Int) -> XUnion (HashSet.HashSet Int) -> Bool+    assXUnionHashSet = associates++    comXUnionSet :: XUnion (Set.Set Int) -> XUnion (Set.Set Int) -> Bool+    comXUnionSet = commutes+    comXUnionMap :: XUnion (Map.Map Int Int) -> XUnion (Map.Map Int Int) -> Bool+    comXUnionMap = commutes+    comXUnionIntSet :: XUnion IntSet.IntSet -> XUnion IntSet.IntSet -> Bool+    comXUnionIntSet = commutes+    comXUnionIntMap :: XUnion (IntMap.IntMap Int) -> XUnion (IntMap.IntMap Int) -> Bool+    comXUnionIntMap = commutes+    comXUnionHashSet :: XUnion (HashSet.HashSet Int) -> XUnion (HashSet.HashSet Int) -> Bool+    comXUnionHashSet = commutes+    comXUnionHashMap :: XUnion (HashMap.HashMap Int Int) -> XUnion (HashMap.HashMap Int Int) -> Bool+    comXUnionHashMap = commutes+    comXUnionOMSet :: XUnion (OM.OMSet Int) -> XUnion (OM.OMSet Int) -> Bool+    comXUnionOMSet = commutes+    comXUnionUMSet :: XUnion (UM.UMSet Int) -> XUnion (UM.UMSet Int) -> Bool+    comXUnionUMSet = commutes++    uniqueUnionUUSet :: UU.UUSet Int -> UU.UUSet Int -> Bool+    uniqueUnionUUSet x y = noDuplicates $ UU.unUUSet $ x `union` y+    uniqueIntersectionUUSet :: UU.UUSet Int -> UU.UUSet Int -> Bool+    uniqueIntersectionUUSet x y = noDuplicates $ UU.unUUSet $ x `intersection` y+    uniqueDifferenceUUSet :: UU.UUSet Int -> UU.UUSet Int -> Bool+    uniqueDifferenceUUSet x y = noDuplicates $ UU.unUUSet $ x `difference` y++    noDuplicates :: Ord a => [a] -> Bool+    noDuplicates xs = length xs == Set.size (Set.fromList xs)++    orderedUnionOMSet :: OM.OMSet Int -> OM.OMSet Int -> Bool+    orderedUnionOMSet x y = ascending $ OM.unOMSet $ x `union` y++    ascending :: ( Foldable f+                 , Ord a+                 , Bounded a+                 ) => f a -> Bool+    ascending = isJust . foldr (\a b -> isLess a =<< b) (Just maxBound)+      where+        isLess x y = x <$ guard (x <= y)++associates :: (Eq a, Monoid a) => a -> a -> a -> Bool+associates x y z = x <> (y <> z) == (x <> y) <> z++commutes :: (Eq a, Commutative a) => a -> a -> Bool+commutes x y = x <~> y == y <~> x+++instance Arbitrary a => Arbitrary (Union a) where+  arbitrary = Union <$> arbitrary++instance Arbitrary a => Arbitrary (Intersection a) where+  arbitrary = Intersection <$> arbitrary++instance Arbitrary a => Arbitrary (XUnion a) where+  arbitrary = XUnion <$> arbitrary++---------++newtype Under20 a = Under20 {unUnder20 :: [a]}+  deriving (Show, Eq)++instance Arbitrary a => Arbitrary (Under20 a) where+  arbitrary = Under20 <$> arbitrary `suchThat` (\x -> length x <= 20)