--
-- An efficient implementation of sets.
--
--- This module is intended to be imported @qualified@, to avoid name
--- clashes with "Prelude" functions. eg.
+-- Since many function names (but not the type name) clash with
+-- "Prelude" names, this module is usually imported @qualified@, e.g.
--
--- > import Data.Set as Set
+-- > import Data.Set (Set)
+-- > import qualified Data.Set as Set
--
-- The implementation of 'Set' is based on /size balanced/ binary trees (or
-- trees of /bounded balance/) as described by:
-- SIAM journal of computing 2(1), March 1973.
--
-- Note that the implementation is /left-biased/ -- the elements of a
--- first argument are always perferred to the second, for example in
+-- first argument are always preferred to the second, for example in
-- 'union' or 'insert'. Of course, left-biasing can only be observed
-- when equality is an equivalence relation instead of structural
-- equality.
module Data.Set (
-- * Set type
- Set -- instance Eq,Show
+ Set -- instance Eq,Ord,Show,Read,Data,Typeable
-- * Operators
, (\\)
, null
, size
, member
+ , notMember
, isSubsetOf
, isProperSubsetOf
, deleteMax
, deleteFindMin
, deleteFindMax
+ , maxView
+ , minView
-- * Conversion
, showTree
, showTreeWith
, valid
-
- -- * Old interface, DEPRECATED
- ,emptySet, -- :: Set a
- mkSet, -- :: Ord a => [a] -> Set a
- setToList, -- :: Set a -> [a]
- unitSet, -- :: a -> Set a
- elementOf, -- :: Ord a => a -> Set a -> Bool
- isEmptySet, -- :: Set a -> Bool
- cardinality, -- :: Set a -> Int
- unionManySets, -- :: Ord a => [Set a] -> Set a
- minusSet, -- :: Ord a => Set a -> Set a -> Set a
- mapSet, -- :: Ord a => (b -> a) -> Set b -> Set a
- intersect, -- :: Ord a => Set a -> Set a -> Set a
- addToSet, -- :: Ord a => Set a -> a -> Set a
- delFromSet, -- :: Ord a => Set a -> a -> Set a
) where
-import Prelude hiding (filter,foldr,foldl,null,map)
-import Data.Monoid
+import Prelude hiding (filter,foldr,null,map)
import qualified Data.List as List
+import Data.Monoid (Monoid(..))
import Data.Typeable
+import Data.Foldable (Foldable(foldMap))
{-
-- just for testing
-}
#if __GLASGOW_HASKELL__
+import Text.Read
import Data.Generics.Basics
import Data.Generics.Instances
#endif
type Size = Int
+instance Ord a => Monoid (Set a) where
+ mempty = empty
+ mappend = union
+ mconcat = unions
+
+instance Foldable Set where
+ foldMap f Tip = mempty
+ foldMap f (Bin _s k l r) = foldMap f l `mappend` f k `mappend` foldMap f r
+
#if __GLASGOW_HASKELL__
{--------------------------------------------------------------------
toConstr _ = error "toConstr"
gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNorepType "Data.Set.Set"
+ dataCast1 f = gcast1 f
#endif
GT -> member x r
EQ -> True
+-- | /O(log n)/. Is the element not in the set?
+notMember :: Ord a => a -> Set a -> Bool
+notMember x t = not $ member x t
+
{--------------------------------------------------------------------
Construction
--------------------------------------------------------------------}
Insertion, Deletion
--------------------------------------------------------------------}
-- | /O(log n)/. Insert an element in a set.
+-- If the set already contains an element equal to the given value,
+-- it is replaced with the new value.
insert :: Ord a => a -> Set a -> Set a
insert x t
= case t of
-- | /O(n+m)/. Is this a subset?
--- @(s1 `isSubsetOf` s2)@ tells whether s1 is a subset of s2.
+-- @(s1 `isSubsetOf` s2)@ tells whether @s1@ is a subset of @s2@.
isSubsetOf :: Ord a => Set a -> Set a -> Bool
isSubsetOf t1 t2
= (size t1 <= size t2) && (isSubsetOfX t1 t2)
isSubsetOfX (Bin _ x l r) t
= found && isSubsetOfX l lt && isSubsetOfX r gt
where
- (found,lt,gt) = splitMember x t
+ (lt,found,gt) = splitMember x t
{--------------------------------------------------------------------
{--------------------------------------------------------------------
Union.
--------------------------------------------------------------------}
--- | The union of a list of sets: (@unions == foldl union empty@).
+-- | The union of a list of sets: (@'unions' == 'foldl' 'union' 'empty'@).
unions :: Ord a => [Set a] -> Set a
unions ts
= foldlStrict union empty ts
--- | /O(n+m)/. The union of two sets. Uses the efficient /hedge-union/ algorithm.
+-- | /O(n+m)/. The union of two sets, preferring the first set when
+-- equal elements are encountered.
+-- The implementation uses the efficient /hedge-union/ algorithm.
-- Hedge-union is more efficient on (bigset `union` smallset).
union :: Ord a => Set a -> Set a -> Set a
union Tip t2 = t2
union t1 Tip = t1
-union t1 t2
- | size t1 >= size t2 = hedgeUnion (const LT) (const GT) t1 t2
- | otherwise = hedgeUnion (const LT) (const GT) t2 t1
+union t1 t2 = hedgeUnion (const LT) (const GT) t1 t2
hedgeUnion cmplo cmphi t1 Tip
= t1
Intersection
--------------------------------------------------------------------}
-- | /O(n+m)/. The intersection of two sets.
--- Intersection is more efficient on (bigset `intersection` smallset).
+-- Elements of the result come from the first set, so for example
+--
+-- > import qualified Data.Set as S
+-- > data AB = A | B deriving Show
+-- > instance Ord AB where compare _ _ = EQ
+-- > instance Eq AB where _ == _ = True
+-- > main = print (S.singleton A `S.intersection` S.singleton B,
+-- > S.singleton B `S.intersection` S.singleton A)
+--
+-- prints @(fromList [A],fromList [B])@.
intersection :: Ord a => Set a -> Set a -> Set a
intersection Tip t = Tip
intersection t Tip = Tip
-intersection t1 t2
- | size t1 >= size t2 = intersect' t1 t2
- | otherwise = intersect' t2 t1
-
-intersect' Tip t = Tip
-intersect' t Tip = Tip
-intersect' t (Bin _ x l r)
- | found = join x tl tr
- | otherwise = merge tl tr
- where
- (found,lt,gt) = splitMember x t
- tl = intersect' lt l
- tr = intersect' gt r
-
+intersection t1@(Bin s1 x1 l1 r1) t2@(Bin s2 x2 l2 r2) =
+ if s1 >= s2 then
+ let (lt,found,gt) = splitLookup x2 t1
+ tl = intersection lt l2
+ tr = intersection gt r2
+ in case found of
+ Just x -> join x tl tr
+ Nothing -> merge tl tr
+ else let (lt,found,gt) = splitMember x1 t2
+ tl = intersection l1 lt
+ tr = intersection r1 gt
+ in if found then join x1 tl tr
+ else merge tl tr
{--------------------------------------------------------------------
Filter and partition
----------------------------------------------------------------------}
-- | /O(n*log n)/.
--- @map f s@ is the set obtained by applying @f@ to each element of @s@.
+-- @'map' f s@ is the set obtained by applying @f@ to each element of @s@.
--
-- It's worth noting that the size of the result may be smaller if,
-- for some @(x,y)@, @x \/= y && f x == f y@
-- | /O(n)/. The
--
--- @mapMonotonic f s == 'map' f s@, but works only when @f@ is monotonic.
+-- @'mapMonotonic' f s == 'map' f s@, but works only when @f@ is monotonic.
-- /The precondition is not checked./
-- Semi-formally, we have:
--
{--------------------------------------------------------------------
Lists
--------------------------------------------------------------------}
--- | /O(n)/. Convert the set to an ascending list of elements.
+-- | /O(n)/. Convert the set to a list of elements.
toList :: Set a -> [a]
toList s
= toAscList s
compare s1 s2 = compare (toAscList s1) (toAscList s2)
{--------------------------------------------------------------------
- Monoid
---------------------------------------------------------------------}
-
-instance Ord a => Monoid (Set a) where
- mempty = empty
- mappend = union
- mconcat = unions
-
-{--------------------------------------------------------------------
Show
--------------------------------------------------------------------}
instance Show a => Show (Set a) where
- showsPrec d s = showSet (toAscList s)
+ showsPrec p xs = showParen (p > 10) $
+ showString "fromList " . shows (toList xs)
showSet :: (Show a) => [a] -> ShowS
showSet []
where
showTail [] = showChar '}'
showTail (x:xs) = showChar ',' . shows x . showTail xs
-
+
+{--------------------------------------------------------------------
+ Read
+--------------------------------------------------------------------}
+instance (Read a, Ord a) => Read (Set a) where
+#ifdef __GLASGOW_HASKELL__
+ readPrec = parens $ prec 10 $ do
+ Ident "fromList" <- lexP
+ xs <- readPrec
+ return (fromList xs)
+
+ readListPrec = readListPrecDefault
+#else
+ readsPrec p = readParen (p > 10) $ \ r -> do
+ ("fromList",s) <- lex r
+ (xs,t) <- reads s
+ return (fromList xs,t)
+#endif
{--------------------------------------------------------------------
Typeable/Data
{--------------------------------------------------------------------
Split
--------------------------------------------------------------------}
--- | /O(log n)/. The expression (@split x set@) is a pair @(set1,set2)@
+-- | /O(log n)/. The expression (@'split' x set@) is a pair @(set1,set2)@
-- where all elements in @set1@ are lower than @x@ and all elements in
-- @set2@ larger than @x@. @x@ is not found in neither @set1@ nor @set2@.
split :: Ord a => a -> Set a -> (Set a,Set a)
-- | /O(log n)/. Performs a 'split' but also returns whether the pivot
-- element was found in the original set.
-splitMember :: Ord a => a -> Set a -> (Bool,Set a,Set a)
-splitMember x Tip = (False,Tip,Tip)
-splitMember x (Bin sy y l r)
- = case compare x y of
- LT -> let (found,lt,gt) = splitMember x l in (found,lt,join y gt r)
- GT -> let (found,lt,gt) = splitMember x r in (found,join y l lt,gt)
- EQ -> (True,l,r)
+splitMember :: Ord a => a -> Set a -> (Set a,Bool,Set a)
+splitMember x t = let (l,m,r) = splitLookup x t in
+ (l,maybe False (const True) m,r)
+
+-- | /O(log n)/. Performs a 'split' but also returns the pivot
+-- element that was found in the original set.
+splitLookup :: Ord a => a -> Set a -> (Set a,Maybe a,Set a)
+splitLookup x Tip = (Tip,Nothing,Tip)
+splitLookup x (Bin sy y l r)
+ = case compare x y of
+ LT -> let (lt,found,gt) = splitLookup x l in (lt,found,join y gt r)
+ GT -> let (lt,found,gt) = splitLookup x r in (join y l lt,found,gt)
+ EQ -> (l,Just y,r)
{--------------------------------------------------------------------
Utility functions that maintain the balance properties of the tree.
Bin _ x l r -> let (xm,r') = deleteFindMax r in (xm,balance x l r')
Tip -> (error "Set.deleteFindMax: can not return the maximal element of an empty set", Tip)
+-- | /O(log n)/. Retrieves the minimal key of the set, and the set stripped from that element
+-- @fail@s (in the monad) when passed an empty set.
+minView :: Monad m => Set a -> m (a, Set a)
+minView Tip = fail "Set.minView: empty set"
+minView x = return (deleteFindMin x)
+
+-- | /O(log n)/. Retrieves the maximal key of the set, and the set stripped from that element
+-- @fail@s (in the monad) when passed an empty set.
+maxView :: Monad m => Set a -> m (a, Set a)
+maxView Tip = fail "Set.maxView: empty set"
+maxView x = return (deleteFindMax x)
+
{--------------------------------------------------------------------
[balance x l r] balances two trees with value x.
{- | /O(n)/. The expression (@showTreeWith hang wide map@) shows
the tree that implements the set. If @hang@ is
@True@, a /hanging/ tree is shown otherwise a rotated tree is shown. If
- @wide@ is true, an extra wide version is shown.
+ @wide@ is 'True', an extra wide version is shown.
> Set> putStrLn $ showTreeWith True False $ fromDistinctAscList [1..5]
> 4
prop_List xs
= (sort (nub xs) == toList (fromList xs))
-}
-
-{--------------------------------------------------------------------
- Old Data.Set compatibility interface
---------------------------------------------------------------------}
-
-{-# DEPRECATED emptySet "Use empty instead" #-}
--- | Obsolete equivalent of 'empty'.
-emptySet :: Set a
-emptySet = empty
-
-{-# DEPRECATED mkSet "Use fromList instead" #-}
--- | Obsolete equivalent of 'fromList'.
-mkSet :: Ord a => [a] -> Set a
-mkSet = fromList
-
-{-# DEPRECATED setToList "Use elems instead." #-}
--- | Obsolete equivalent of 'elems'.
-setToList :: Set a -> [a]
-setToList = elems
-
-{-# DEPRECATED unitSet "Use singleton instead." #-}
--- | Obsolete equivalent of 'singleton'.
-unitSet :: a -> Set a
-unitSet = singleton
-
-{-# DEPRECATED elementOf "Use member instead." #-}
--- | Obsolete equivalent of 'member'.
-elementOf :: Ord a => a -> Set a -> Bool
-elementOf = member
-
-{-# DEPRECATED isEmptySet "Use null instead." #-}
--- | Obsolete equivalent of 'null'.
-isEmptySet :: Set a -> Bool
-isEmptySet = null
-
-{-# DEPRECATED cardinality "Use size instead." #-}
--- | Obsolete equivalent of 'size'.
-cardinality :: Set a -> Int
-cardinality = size
-
-{-# DEPRECATED unionManySets "Use unions instead." #-}
--- | Obsolete equivalent of 'unions'.
-unionManySets :: Ord a => [Set a] -> Set a
-unionManySets = unions
-
-{-# DEPRECATED minusSet "Use difference instead." #-}
--- | Obsolete equivalent of 'difference'.
-minusSet :: Ord a => Set a -> Set a -> Set a
-minusSet = difference
-
-{-# DEPRECATED mapSet "Use map instead." #-}
--- | Obsolete equivalent of 'map'.
-mapSet :: (Ord a, Ord b) => (b -> a) -> Set b -> Set a
-mapSet = map
-
-{-# DEPRECATED intersect "Use intersection instead." #-}
--- | Obsolete equivalent of 'intersection'.
-intersect :: Ord a => Set a -> Set a -> Set a
-intersect = intersection
-
-{-# DEPRECATED addToSet "Use 'flip insert' instead." #-}
--- | Obsolete equivalent of @'flip' 'insert'@.
-addToSet :: Ord a => Set a -> a -> Set a
-addToSet = flip insert
-
-{-# DEPRECATED delFromSet "Use `flip delete' instead." #-}
--- | Obsolete equivalent of @'flip' 'delete'@.
-delFromSet :: Ord a => Set a -> a -> Set a
-delFromSet = flip delete
projects / haskell-directory.git / blobdiff