-- 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.
, null
, size
, member
+ , notMember
, isSubsetOf
, isProperSubsetOf
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
--------------------------------------------------------------------}
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.
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
- (lt,found,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
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 []
Read
--------------------------------------------------------------------}
instance (Read a, Ord a) => Read (Set a) where
- readsPrec i r = [ (fromList xs, t) | ("{",s) <- lex r, (xs,t) <- readl s ]
- where readl s = [([],t) | ("}",t) <- lex s] ++
- [(x:xs,u) | (x,t) <- readsPrec i s
- , (xs,u) <- readl' t]
- readl' s = [([],t) | ("}",t) <- lex s] ++
- [(x:xs,v) | (",",t) <- lex s
- , (x,u) <- readsPrec i t
- , (xs,v) <- readl' u]
-
+#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
--------------------------------------------------------------------}
-- | /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 -> (Set a,Bool,Set a)
-splitMember x Tip = (Tip,False,Tip)
-splitMember x (Bin sy y l r)
- = case compare x y of
- LT -> let (lt,found,gt) = splitMember x l in (lt,found,join y gt r)
- GT -> let (lt,found,gt) = splitMember x r in (join y l lt,found,gt)
- EQ -> (l,True,r)
+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.