> module OrdList ( Set(..), OrdList(..), > -- construction > empty, singleton, union, unionMany, > add, addMany, > -- modification > intersect, delete, deleteMany, minus, > -- map, partition, filter, foldl, foldr, > -- conversion > toList, fromList, > -- size > -- length, genericLength > -- testing > --null > isSingleton, intersecting, isSubsetOf, > setElem, > -- substitution > replaceMaybe, substitute, > -- *additional functions* > toSortedList, fromSortedList > ) > where
> import Sort ( mergeSort, unique )
> type Set a = OrdList aOrdered lists with no duplicates.
> type OrdList a = [a]Lists are already instances of
Eq and Ord.
> --instance Eq a => Eq (Set a) > --instance Ord a => Ord (Set a)
> empty :: Set a > empty = []
> singleton :: a -> Set a > singleton a = [a]
union corresponds to merge.
> union :: Ord a => Set a -> Set a -> Set a > union [] y = y > union x@(_:_) [] = x > union x@(a:x') y@(b:y') = case compare a b of > _LT -> a : union x' y > _EQ -> b : union x' y' > _GT -> b : union x y'
> unionMany :: Ord a => [Set a] -> Set a > unionMany = foldl union empty
add corresponds to insert.
> add :: Ord a => a -> Set a -> Set a > add a [] = [a] > add a x@(b:x') = case compare a b of > _LT -> a : x > _EQ -> a : x' > _GT -> b : add a x'
> addMany :: Ord a => [a] -> Set a -> Set a > --addMany x s = foldr add s x -- insertion sort > addMany x s = fromList x `union` s -- merge sort
> intersect :: Ord a => Set a -> Set a -> Set a > intersect [] y = [] > intersect x@(_:_) [] = [] > intersect x@(a:x') y@(b:y') = case compare a b of > _LT -> intersect x' y > _EQ -> a : intersect x' y' > _GT -> intersect x y'ToDo: should
delete complain if the element is not contained in the
list?
> delete :: Ord a => a -> Set a -> Set a > delete a [] = [] > delete a x@(b:x') = case compare a b of > _LT -> x > _EQ -> x' > _GT -> b : delete a x'
> deleteMany :: Ord a => [a] -> Set a -> Set a > deleteMany x s = foldr delete s x
> minus :: Ord a => Set a -> Set a -> Set a > minus [] y = [] > minus x@(_:_) [] = x > minus x@(a:x') y@(b:y') = case compare a b of > _LT -> a : minus x' y > _EQ -> minus x' y' > _GT -> minus x y'Note:
map, partition, filter, foldl, foldr
need no redefinition.
> --map :: (a -> b) -> Set a -> Set a > --partition :: (a -> Bool) -> Set a -> (Set a, Set a) > --foldl :: (a -> b -> a) -> a -> Set b -> a > --foldr :: (a -> b -> b) -> b -> Set a -> b
> toList :: Set a -> [a] > toList = id
> fromList :: Ord a => [a] -> Set a > fromList = fromSortedList . mergeSort
length and genericLength need no redefinition.
> --length :: Set a -> Int > --genericLength :: Integral i => Set a -> i
null needs no redefinition.
> --null :: Set a -> Bool
> isSingleton :: Set a -> Bool > isSingleton [a] = True > isSingleton _ = False
> intersecting :: Ord a => Set a -> Set a -> Bool > intersecting [] y = False > intersecting x@(_:_) [] = False > intersecting x@(a:x') y@(b:y')= case compare a b of > _LT -> intersecting x' y > _EQ -> True > _GT -> intersecting x y'
> isSubsetOf :: Ord a => Set a -> Set a -> Bool > isSubsetOf [] y = True > isSubsetOf x@(_:_) [] = False > isSubsetOf x@(a:x') y@(b:y') = case compare a b of > _LT -> False > _EQ -> isSubsetOf x' y' > _GT -> isSubsetOf x y'Note:
setElem instead of elem.
> setElem :: Ord a => a -> Set a -> Bool > setElem a [] = False > setElem a x@(b:x') = case compare a b of > _LT -> False > _EQ -> True > _GT -> setElem a x'
replaceMaybe and substitute are quick hacks.
> replaceMaybe :: Ord a => (a -> Maybe a) -> Set a -> Set a > replaceMaybe f x = fromList [ b | a<-x, Just b<-[f a] ]
> substitute :: Ord a => a -> a -> Set a -> Set a > substitute a b x > | a `setElem` x = add b (delete a x) > | otherwise = x
> toSortedList :: Set a -> [a] > toSortedList = id
> fromSortedList :: Eq a => [a] -> Set a > fromSortedList = uniqueToDo:
forceDelete which complains if the element is not contained
in the list. Useful for substitute.
> --forceDelete :: Ord a => a -> Set a -> Maybe (Set a)
> compare :: Ord a => a -> a -> _CMP_TAG
> compare = _tagCmp
> {-# INLINE compare #-}