Commit e955e3cd by Peter Achten Committed by Camil Staps

### Data.SetBy is the higher-order version of Data.Set

parent 34949e68
 definition module Data.SetBy /** * An efficient implementation of sets. * * This version is the same as Data.Set, except that the overloaded API is replaced * with a higher-order function API. * * For all documentation, please consult Data.Set. * * The `morally equivalent` function from Data.Set is added in the comment. * * When using the functions in Data.SetBy, make sure to use the same higher-order * function parameter for the same data structure to ensure internal integrity. * This higher-order function represents the < ordering on your set elements and * should have the usual ordering properties: * * - if a < b and b < c then a < c * - if a < b then not (b < a) * - if not (a < b) and not (b < a) then a and b are considered to 'equal' * */ from StdOverloaded import class ==, class < (..) from StdClass import class Ord (..), <=, > from StdList import foldl, map from Data.Maybe import :: Maybe from StdBool import not, && from Data.GenLexOrd import :: LexOrd import qualified Data.Foldable from Data.Foldable import class Foldable :: SetBy a = TipBy | BinBy !Int !a !(SetBy a) !(SetBy a) instance == (SetBy a) | == a /** * True iff first set is `smaller` than second set, according to * first argument (assuming the two sets are ordered with the * same first function argument). * * Morally equivalent function: instance < (Set a) | < a */ isOrderedBy :: !(a a -> Bool) !(SetBy a) !(SetBy a) -> Bool /** * EQ iff the two sets have the same number of elements, occurring in the * same order. * LT iff the first set is the common prefix of the second set or the common * prefix is followed in the first set with an element that is considered * than the corresponding element in the second set. * GT iff the second set is the common prefix of the first set or the common * prefix is followed in the second set with an element that is considered * greater than the corresponding element in the first set. * The comparison of elements is done with the first function argument. * * Morally equivalent function: derive gLexOrd Set */ lexOrdBy :: !(a a -> Bool) !(SetBy a) !(SetBy a) -> LexOrd instance Foldable SetBy /** * True iff this is the empty set. * @type (SetBy a) -> Bool * @property equivalence with size 0: A.s :: SetBy a: * size s == 0 <==> null s * @property equivalence with newSet: A.s :: SetBy a: * s == newSetBy <==> null s */ null s :== case s of TipBy -> True (BinBy sz _ _ _) -> False /** * The number of elements in the set. * @type (SetBy a) -> Int * @property correctness: A.s :: SetBy a: * size s =.= length (toList s) */ size s :== case s of TipBy -> 0 (BinBy sz _ _ _) -> sz /** * Is the element in the set? * * Morally equivalent function: Data.Set.member x s = Data.SetBy.memberBy (<) x s */ memberBy :: !(a a -> Bool) !a !(SetBy a) -> Bool /** * Checks if an element is not in the set. */ notMemberBy comp x t :== not (memberBy comp x t) /** * Is t1 a subset of t2? * * Morally equivalent function: Data.Set.isSubsetOf s1 s2 = Data.SetBy.isSubsetOfBy (<) s1 s2 */ isSubsetOfBy comp t1 t2 :== (size t1 <= size t2) && (isSubsetOfXBy comp t1 t2) isSubsetOfXBy :: !(a a -> Bool) !(SetBy a) !(SetBy a) -> Bool /** * Is t1 a proper subset of t2? * * Morally equivalent function: Data.Set.isProperSubsetOf s1 s2 = Data.SetBy.isProperSubsetOfBy (<) s1 s2 */ isProperSubsetOfBy comp s1 s2 :== (size s1 < size s2) && (isSubsetOfBy comp s1 s2) /** * The empty set. * @complexity O(1) * @property is null: * null newSetBy */ newSetBy :: SetBy a /** * Create a singleton set. * @complexity O(1) */ singletonBy :: !u:a -> w:(SetBy u:a), [w <= u] /** * 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. * * Morally equivalent function: Data.Set.insert x s = Data.SetBy.insertBy (<) x s */ insertBy :: !(a a -> Bool) !a !.(SetBy a) -> SetBy a /** * Delete an element from a set. * * Morally equivalent function: Data.Set.delete x s = Data.SetBy (<) x s */ deleteBy :: !(a a -> Bool) !a !.(SetBy a) -> SetBy a /** * The minimal element of a set. * * Morally equivalent function: Data.Set.findMin */ findMin :: !(SetBy a) -> a /** * The maximal element of a set. * * Morally equivalent function: Data.Set.findMax */ findMax :: !(SetBy a) -> a /** * Delete the minimal element. * * Morally equivalent function: Data.Set.deleteMin */ deleteMin :: !.(SetBy a) -> SetBy a /** * Delete the maximal element. * * Morally equivalent function: Data.Set.deleteMax */ deleteMax :: !.(SetBy a) -> SetBy a /** * deleteFindMin set = (findMin set, deleteMin set) */ deleteFindMin :: !.(SetBy a) -> (!a, !SetBy a) /** * deleteFindMax set = (findMax set, deleteMax set) */ deleteFindMax :: !.(SetBy a) -> (!a, !SetBy a) /** * Retrieves the minimal key of the set, and the set stripped of that element, * or 'Nothing' if passed an empty set. */ minView :: !.(SetBy a) -> .(Maybe (!a, !SetBy a)) /** * Retrieves the maximal key of the set, and the set stripped of that element, * or 'Nothing' if passed an empty set. */ maxView :: !.(SetBy a) -> .(Maybe (!a, !SetBy a)) /** * The union of two sets, preferring the first set when equal elements are * encountered. * * Morally equivalent function: Data.Set.union s1 s2 = Data.SetBy.unionBy (<) s1 s2 */ unionBy :: !(a a -> Bool) !u:(SetBy a) !u:(SetBy a) -> SetBy a /** * The union of a list of sets. * * Morally equivalent function: Data.Set.unions ts = Data.SetBy.unionsBy (<) ts */ unionsBy ts :== foldl unionBy newSetBy ts /** * Difference of two sets. * * Morally equivalent function: Data.Set.difference s1 s2 = Data.SetBy.differenceBy (<) s1 s2 */ differenceBy :: !(a a -> Bool) !(SetBy a) !(SetBy a) -> SetBy a /** * The intersection of two sets. * Elements of the result come from the first set. * * Morally equivalent function: Data.Set.intersection s1 s2 = Data.SetBy.intersectionBy (<) s1 s2 */ intersectionBy :: !(a a -> Bool) !(SetBy a) !(SetBy a) -> SetBy a /** * The intersection of a list of sets. * Elements of the result come from the first set * * Morally equivalent function: Data.Set.intersections ts = Data.SetBy.intersectionsBy (<) ts */ intersectionsBy :: !(a a -> Bool) ![SetBy a] -> SetBy a /** * Filter all elements that satisfy the predicate. * * Morally equivalent function: Data.Set.filter */ filter :: !(a -> Bool) !(SetBy a) -> SetBy a /** * Partition the set into two sets, one with all elements that satisfy the * predicate and one with all elements that don't satisfy the predicate. * * Morally equivalent function: Data.Set.partition */ partition :: !(a -> Bool) !(SetBy a) -> (!SetBy a, !SetBy a) /** * Split a set in elements less and elements greater than a certain pivot. * * Morally equivalent function: Data.Set.split x s = Data.SetBy.splitBy (<) x s */ splitBy :: !(a a -> Bool) !a !(SetBy a) -> (!SetBy a, !SetBy a) /** * Performs a 'split' but also returns whether the pivot element was found in * the original set. * * Morally equivalent function: Data.Set.splitMember x s = Data.SetBy.splitMemberBy (<) x s */ splitMemberBy :: !(a a -> Bool) !a !(SetBy a) -> (!SetBy a, !Bool, !SetBy a) /** * Convert the set to an ascending list of elements. */ toList s :== toAscList s /** * Same as toList. */ toAscList t :== 'Data.Foldable'.foldr` (\a as -> [a:as]) [] t /** * Create a set from a list of elements. * * Morally equivalent function: Data.Set.fromList xs = Data.SetBy.fromListBy (<) xs */ fromListBy :: !(a a -> Bool) ![a] -> SetBy a /** * Map a function to all elements in a set. * * Morally equivalent function: Data.Set.mapSet f s = Data.SetBy.mapSetBy (<) f s */ mapSetBy comp_b f s :== fromListBy comp_b (map f (toList s)) /** * Map a set without converting it to and from a list. * * Morally equivalent function: Data.Set.mapSetMonotonic */ mapSetByMonotonic :: !(a -> b) !(SetBy a) -> SetBy b
 implementation module Data.SetBy import StdClass, StdMisc, StdBool, StdFunc, StdInt import Data.Maybe from Data.GenLexOrd import :: LexOrd (..) import Data.Monoid from Data.Foldable import class Foldable (..) import qualified StdList from StdList import instance == [a] // PA: this is a dangerous function... shouldn't be part of the API mapSetByMonotonic :: !(a -> b) !(SetBy a) -> SetBy b mapSetByMonotonic _ TipBy = TipBy mapSetByMonotonic f (BinBy n x l r) = BinBy n (f x) (mapSetByMonotonic f l) (mapSetByMonotonic f r) /* * Sets are size balanced trees. * A set of values @a@. */ :: SetBy a = TipBy | BinBy !Int !a !(SetBy a) !(SetBy a) instance == (SetBy a) | == a where (==) t1 t2 = size t1 == size t2 && toAscList t1 == toAscList t2 isOrderedBy :: !(a a -> Bool) !(SetBy a) !(SetBy a) -> Bool isOrderedBy comp s1 s2 = compare comp (toAscList s1) (toAscList s2) where compare :: !(a a -> Bool) ![a] ![a] -> Bool compare _ [] [] = False compare _ [] _ = True compare _ [_:_] [] = False compare comp [a:as] [b:bs] | comp a b = True | comp b a = False | otherwise = compare comp as bs lexOrdBy :: !(a a -> Bool) !(SetBy a) !(SetBy a) -> LexOrd lexOrdBy comp s1 s2 = ordby comp (toAscList s1) (toAscList s2) where ordby :: !(a a -> Bool) ![a] ![a] -> LexOrd ordby _ [] [] = EQ ordby _ [] _ = LT ordby _ [_:_] [] = GT ordby comp [a:as] [b:bs] | comp a b = LT | comp b a = GT | otherwise = ordby comp as bs instance Foldable SetBy where foldr f z (BinBy _ x l r) = foldr f (f x (foldr f z r)) l foldr _ z _ = z foldr` f z (BinBy _ x l r) = foldr` f (f x (foldr` f z r)) l foldr` _ z _ = z foldl f z (BinBy _ x l r) = foldl f (f (foldl f z l) x) r foldl _ z _ = z foldl` f z (BinBy _ x l r) = foldl` f (f (foldl` f z l) x) r foldl` _ z _ = z /*-------------------------------------------------------------------- * Query *--------------------------------------------------------------------*/ memberBy :: !(a a -> Bool) !a !(SetBy a) -> Bool memberBy comp x (BinBy _ y l r) | comp x y = memberBy comp x l | comp y x = memberBy comp x r | otherwise = True memberBy _ _ _ = False /*-------------------------------------------------------------------- * Construction *--------------------------------------------------------------------*/ newSetBy :: SetBy a newSetBy = TipBy singletonBy :: !u:a -> w:(SetBy u:a), [w <= u] singletonBy x = BinBy 1 x TipBy TipBy /*-------------------------------------------------------------------- * Insertion, Deletion *--------------------------------------------------------------------*/ insertBy :: !(a a -> Bool) !a !.(SetBy a) -> SetBy a insertBy comp x t=:(BinBy _ y l r) | comp x y = balanceL y (insertBy comp x l) r | comp y x = balanceR y l (insertBy comp x r) | otherwise = t insertBy _ x _ = singletonBy x deleteBy :: !(a a -> Bool) !a !.(SetBy a) -> SetBy a deleteBy comp x (BinBy _ y l r) | comp x y = balanceR y (deleteBy comp x l) r | comp y x = balanceL y l (deleteBy comp x r) | otherwise = glue l r deleteBy _ _ tip = tip /*-------------------------------------------------------------------- * Subset *--------------------------------------------------------------------*/ isSubsetOfXBy :: !(a a -> Bool) !(SetBy a) !(SetBy a) -> Bool isSubsetOfXBy comp (BinBy _ x l r) t | t =: TipBy = False #! (lt, found, gt) = splitMemberBy comp x t = found && isSubsetOfXBy comp l lt && isSubsetOfXBy comp r gt isSubsetOfXBy _ _ _ = True /*-------------------------------------------------------------------- * Minimal, Maximal *--------------------------------------------------------------------*/ findMin :: !(SetBy a) -> a findMin (BinBy _ x TipBy _) = x findMin (BinBy _ _ l _) = findMin l findMin TipBy = abort "SetBy.findMin: empty set has no minimal element" findMax :: !(SetBy a) -> a findMax (BinBy _ x _ TipBy) = x findMax (BinBy _ _ _ r) = findMax r findMax TipBy = abort "SetBy.findMax: empty set has no maximal element" deleteMin :: !.(SetBy a) -> SetBy a deleteMin (BinBy _ _ TipBy r) = r deleteMin (BinBy _ x l r) = balanceR x (deleteMin l) r deleteMin TipBy = TipBy deleteMax :: !.(SetBy a) -> SetBy a deleteMax (BinBy _ _ l TipBy) = l deleteMax (BinBy _ x l r) = balanceL x l (deleteMax r) deleteMax TipBy = TipBy /*-------------------------------------------------------------------- * Union. *--------------------------------------------------------------------*/ unionBy :: !(a a -> Bool) !u:(SetBy a) !u:(SetBy a) -> SetBy a unionBy _ t1 TipBy = t1 unionBy comp t1 (BinBy _ x TipBy TipBy) = insertBy comp x t1 unionBy comp (BinBy _ x TipBy TipBy) t2 = insertBy comp x t2 unionBy _ TipBy t2 = t2 unionBy comp t1=:(BinBy _ x l1 r1) t2 = link x l1l2 r1r2 where (l2,r2) = splitS comp x t2 l1l2 = unionBy comp l1 l2 r1r2 = unionBy comp r1 r2 splitS :: !(a a -> Bool) !a !(SetBy a) -> (!SetBy a, !SetBy a) splitS _ _ TipBy = (TipBy,TipBy) splitS comp x (BinBy _ y l r) | comp x y = let (lt,gt) = splitS comp x l in (lt, link y gt r) | comp y x = let (lt,gt) = splitS comp x r in (link y l lt, gt) | otherwise = (l,r) /*-------------------------------------------------------------------- * Difference *--------------------------------------------------------------------*/ differenceBy :: !(a a -> Bool) !(SetBy a) !(SetBy a) -> SetBy a differenceBy _ TipBy _ = TipBy differenceBy comp t1 t2 = case t2 of BinBy _ x l2 r2 -> case splitBy comp x t1 of (l1, r1) | size l1l2 + size r1r2 == size t1 -> t1 | otherwise -> merge l1l2 r1r2 where l1l2 = differenceBy comp l1 l2 r1r2 = differenceBy comp r1 r2 _ -> t1 /*-------------------------------------------------------------------- * Intersection *--------------------------------------------------------------------*/ intersectionsBy :: !(a a -> Bool) ![SetBy a] -> SetBy a intersectionsBy _ [t] = t intersectionsBy comp [t:ts] = 'StdList'.foldl (intersectionBy comp) t ts intersectionsBy _ [] = abort "SetBy.intersectionsBy called with []\n" intersectionBy :: !(a a -> Bool) !(SetBy a) !(SetBy a) -> SetBy a intersectionBy _ TipBy _ = TipBy intersectionBy _ _ TipBy = TipBy intersectionBy comp t1 t2 = hedgeInt comp NothingS NothingS t1 t2 hedgeInt :: !(a a -> Bool) !(MaybeS a) !(MaybeS a) !(SetBy a) !(SetBy a) -> SetBy a hedgeInt _ _ _ _ TipBy = TipBy hedgeInt _ _ _ TipBy _ = TipBy hedgeInt comp blo bhi (BinBy _ x l r) t2 #! bmi = JustS x #! l` = hedgeInt comp blo bmi l (trimBy comp blo bmi t2) #! r` = hedgeInt comp bmi bhi r (trimBy comp bmi bhi t2) = if (memberBy comp x t2) (link x l` r`) (merge l` r`) /*-------------------------------------------------------------------- * Filter and partition *--------------------------------------------------------------------*/ filter :: !(a -> Bool) !(SetBy a) -> SetBy a filter p (BinBy _ x l r) | p x = link x (filter p l) (filter p r) | otherwise = merge (filter p l) (filter p r) filter _ tip = tip partition :: !(a -> Bool) !(SetBy a) -> (!SetBy a, !SetBy a) partition p (BinBy _ x l r) #! (l1,l2) = partition p l #! (r1,r2) = partition p r | p x = (link x l1 r1,merge l2 r2) | otherwise = (merge l1 r1,link x l2 r2) partition _ t = (t, t) /*-------------------------------------------------------------------- * Lists *--------------------------------------------------------------------*/ fromListBy :: !(a a -> Bool) ![a] -> SetBy a fromListBy comp xs = 'StdList'.foldl (ins comp) newSetBy xs where ins :: !(a a -> Bool) !(SetBy a) !a -> SetBy a ins comp t x = insertBy comp x t /*-------------------------------------------------------------------- Utility functions that return sub-ranges of the original tree. Some functions take a comparison function as argument to allow comparisons against infinite values. A function [cmplo x] should be read as [compare lo x]. [trimBy comp cmplo cmphi t] A tree that is either empty or where [cmplo x == LT] and [cmphi x == GT] for the value [x] of the root. [splitBy comp k t] Returns two trees [l] and [r] where all values in [l] are <[k] and all keys in [r] are >[k]. [splitMemberBy comp k t] Just like [splitBy] but also returns whether [k] was found in the tree. --------------------------------------------------------------------*/ :: MaybeS a = NothingS | JustS !a /*-------------------------------------------------------------------- [trimBy comp lo hi t] trims away all subtrees that surely contain no values between the range [lo] to [hi]. The returned tree is either empty or the key of the root is between @lo@ and @hi@. --------------------------------------------------------------------*/ trimBy :: !(a a -> Bool) !(MaybeS a) !(MaybeS a) !(SetBy a) -> SetBy a trimBy _ NothingS NothingS t = t trimBy comp (JustS lx) NothingS t = greater comp lx t where greater comp lo (BinBy _ x _ r) | not (comp lo x) = greater comp lo r greater _ _ t` = t` trimBy comp NothingS (JustS hx) t = lesser comp hx t where lesser comp hi (BinBy _ x l _) | not (comp x hi) = lesser comp hi l lesser _ _ t` = t` trimBy comp (JustS lx) (JustS hx) t = middle comp lx hx t where middle comp lo hi (BinBy _ x _ r) | not (comp lo x) = middle comp lo hi r middle comp lo hi (BinBy _ x l _) | not (comp x hi) = middle comp lo hi l middle _ _ _ t` = t` /*-------------------------------------------------------------------- * Split *--------------------------------------------------------------------*/ splitBy :: !(a a -> Bool) !a !(SetBy a) -> (!SetBy a, !SetBy a) splitBy comp x (BinBy _ y l r) | comp x y #! (lt, gt) = splitBy comp x l = (lt, link y gt r) | comp y x #! (lt,gt) = splitBy comp x r = (link y l lt,gt) | otherwise = (l, r) splitBy _ _ t = (t, t) splitMemberBy :: !(a a -> Bool) !a !(SetBy a) -> (!SetBy a, !Bool, !SetBy a) splitMemberBy comp x (BinBy _ y l r) | comp x y #! (lt, found, gt) = splitMemberBy comp x l = (lt, found, link y gt r) | comp y x #! (lt, found, gt) = splitMemberBy comp x r = (link y l lt, found, gt) | otherwise = (l, True, r) splitMemberBy _ _ t = (t, False, t) /*-------------------------------------------------------------------- Utility functions that maintain the balance properties of the tree. All constructors assume that all values in [l] < [x] and all values in [r] > [x], and that [l] and [r] are valid trees. In order of sophistication: [BinBy sz x l r] The type constructor.