mini 1.5.3.0 → 1.5.4.0
raw patch · 4 files changed
+753/−488 lines, 4 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
+ Mini.Data.Map: fromAscList :: Eq k => [(k, a)] -> Map k a
+ Mini.Data.Map: fromAscListWith :: Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
+ Mini.Data.Map: fromAscListWithKey :: Ord k => (k -> a -> a -> a) -> [(k, a)] -> Map k a
+ Mini.Data.Map: fromDescList :: Eq k => [(k, a)] -> Map k a
+ Mini.Data.Map: fromDescListWith :: Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
+ Mini.Data.Map: fromDescListWithKey :: Ord k => (k -> a -> a -> a) -> [(k, a)] -> Map k a
+ Mini.Data.Map: fromDistinctAscList :: [(k, a)] -> Map k a
+ Mini.Data.Map: fromDistinctDescList :: [(k, a)] -> Map k a
+ Mini.Data.Set: fromAscList :: Eq a => [a] -> Set a
+ Mini.Data.Set: fromDescList :: Eq a => [a] -> Set a
+ Mini.Data.Set: fromDistinctAscList :: [a] -> Set a
+ Mini.Data.Set: fromDistinctDescList :: [a] -> Set a
- Mini.Data.Map: compose :: (Ord b, Ord a) => Map b c -> Map a b -> Map a c
+ Mini.Data.Map: compose :: Ord b => Map b c -> Map a b -> Map a c
- Mini.Data.Map: filter :: Ord k => (a -> Bool) -> Map k a -> Map k a
+ Mini.Data.Map: filter :: (a -> Bool) -> Map k a -> Map k a
- Mini.Data.Map: filterWithKey :: Ord k => (k -> a -> Bool) -> Map k a -> Map k a
+ Mini.Data.Map: filterWithKey :: (k -> a -> Bool) -> Map k a -> Map k a
- Mini.Data.Map: partition :: Ord k => (a -> Bool) -> Map k a -> (Map k a, Map k a)
+ Mini.Data.Map: partition :: (a -> Bool) -> Map k a -> (Map k a, Map k a)
- Mini.Data.Map: partitionWithKey :: Ord k => (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
+ Mini.Data.Map: partitionWithKey :: (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
- Mini.Data.Set: filter :: Ord a => (a -> Bool) -> Set a -> Set a
+ Mini.Data.Set: filter :: (a -> Bool) -> Set a -> Set a
- Mini.Data.Set: partition :: Ord a => (a -> Bool) -> Set a -> (Set a, Set a)
+ Mini.Data.Set: partition :: (a -> Bool) -> Set a -> (Set a, Set a)
Files
- CHANGELOG.md +37/−0
- Mini/Data/Map.hs +434/−301
- Mini/Data/Set.hs +281/−186
- mini.cabal +1/−1
CHANGELOG.md view
@@ -1,3 +1,40 @@+1.5.4.0 [2025-01-18]+--------------------+* Mini.Data.Map:+ * Add:+ * 'fromDistinct{Asc,Desc}List'+ * 'from{Asc,Desc}List{,With,WithKey}'+ * Major improvements to:+ * 'filter{,WithKey}'+ * 'partition{,WithKey}'+ * 'split'+ * Minor improvements to:+ * 'compose'+ * 'difference'+ * 'differenceWithKey'+ * 'intersectionWithKey'+ * 'unionWithKey'+ * 'delete{Max,Min}'+ * 'update{,Max,Min}WithKey'+ * 'split{Max,Min}'+ * 'disjoint'+ * 'isSubmapOfBy'+* Mini.Data.Set:+ * Add:+ * 'from{Distinct,}{Asc,Desc}List'+ * Major improvements to:+ * 'filter'+ * 'partition'+ * 'split'+ * Minor improvements to:+ * 'difference'+ * 'intersection'+ * 'union'+ * 'delete{Max,Min}'+ * 'split{Max,Min}'+ * 'disjoint'+ * 'isSubsetOf'+ 1.5.3.0 [2025-01-09] -------------------- * Mini.Transformers.ParserT:
Mini/Data/Map.hs view
@@ -1,4 +1,6 @@ {-# LANGUAGE TupleSections #-}+-- incomplete patterns in 'fromDistinct{Asc,Desc}List'+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -- | A structure mapping unique keys to values module Mini.Data.Map (@@ -7,10 +9,18 @@ -- * Construction empty,+ singleton, fromList, fromListWith, fromListWithKey,- singleton,+ fromAscList,+ fromAscListWith,+ fromAscListWithKey,+ fromDescList,+ fromDescListWith,+ fromDescListWithKey,+ fromDistinctAscList,+ fromDistinctDescList, -- * Combination compose,@@ -94,9 +104,17 @@ liftA2, (<|>), )+import Data.Bifunctor (+ bimap,+ first,+ second,+ ) import Data.Bool ( bool, )+import Data.Function (+ on,+ ) import Prelude ( Applicative, Bool (@@ -123,22 +141,27 @@ Traversable, compare, const,+ div, error, flip, fmap, foldl, foldr, fst,+ length, max, maybe, mempty, not, pure, show,+ splitAt, traverse, uncurry,+ until, ($), (&&),+ (*), (+), (-), (.),@@ -167,10 +190,10 @@ R (Map k a) k a (Map k a) instance (Eq k, Eq a) => Eq (Map k a) where- t1 == t2 = toAscList t1 == toAscList t2+ (==) = (==) `on` toAscList instance (Ord k, Ord a) => Ord (Map k a) where- compare t1 t2 = compare (toAscList t1) (toAscList t2)+ compare = compare `on` toAscList instance (Show k, Show a) => Show (Map k a) where show = show . toAscList@@ -220,6 +243,10 @@ empty :: Map k a empty = E +-- | /O(1)/ Make a map with a single bin+singleton :: k -> a -> Map k a+singleton k a = B E k a E+ -- | /O(n log n)/ Make a map from a tail-biased list of @(key, value)@ pairs fromList :: (Ord k) => [(k, a)] -> Map k a fromList = fromListWithKey $ const const@@ -232,24 +259,76 @@ fromListWithKey :: (Ord k) => (k -> a -> a -> a) -> [(k, a)] -> Map k a fromListWithKey f = foldl (flip . uncurry $ insertWithKey f) empty --- | /O(1)/ Make a map with a single bin-singleton :: k -> a -> Map k a-singleton k a = B E k a E+-- | /O(n)/ Make a map from a tail-biased list of key-sorted pairs+fromAscList :: (Eq k) => [(k, a)] -> Map k a+fromAscList = fromDistinctAscList . essence +-- | /O(n)/ Make a map from a list of key-sorted pairs, combining matching keys+fromAscListWith :: (Ord k) => (a -> a -> a) -> [(k, a)] -> Map k a+fromAscListWith = fromAscListWithKey . const++-- | /O(n)/ Make a map from a list of key-sorted pairs, combining matching keys+fromAscListWithKey :: (Ord k) => (k -> a -> a -> a) -> [(k, a)] -> Map k a+fromAscListWithKey f = fromDistinctAscList . essenceWith f++-- | /O(n)/ Make a map from a tail-biased list of key-sorted pairs+fromDescList :: (Eq k) => [(k, a)] -> Map k a+fromDescList = fromDistinctDescList . essence++-- | /O(n)/ Make a map from a list of key-sorted pairs, combining matching keys+fromDescListWith :: (Ord k) => (a -> a -> a) -> [(k, a)] -> Map k a+fromDescListWith = fromDescListWithKey . const++-- | /O(n)/ Make a map from a list of key-sorted pairs, combining matching keys+fromDescListWithKey :: (Ord k) => (k -> a -> a -> a) -> [(k, a)] -> Map k a+fromDescListWithKey f = fromDistinctDescList . essenceWith f++-- | /O(n)/ Make a map from a sorted list of key-distinct pairs+fromDistinctAscList :: [(k, a)] -> Map k a+fromDistinctAscList = go <*> power+ where+ go [] _ = E+ go [(k, a)] _ = B E k a E+ go kas n =+ let len = length kas+ n' = n `div` 2+ c = bool B L $ len == n+ (l, (k, a) : r) = splitAt (len `div` 2) kas+ in c (go l n') k a (go r n')++-- | /O(n)/ Make a map from a sorted list of key-distinct pairs+fromDistinctDescList :: [(k, a)] -> Map k a+fromDistinctDescList = go <*> power+ where+ go [] _ = E+ go [(k, a)] _ = B E k a E+ go kas n =+ let len = length kas+ n' = n `div` 2+ c = bool B R $ len == n+ (l, (k, a) : r) = splitAt (len `div` 2) kas+ in c (go r n') k a (go l n')+ {- - Combination -} -- | /O(n log m)/ Compose the keys of one set with the values of another-compose :: (Ord b, Ord a) => Map b c -> Map a b -> Map a c-compose bc =- foldrWithKey- (\a b ac -> maybe ac (\c -> insert a c ac) $ lookup b bc)- empty+compose :: (Ord b) => Map b c -> Map a b -> Map a c+compose t1 t2 = map empty go go go t1+ where+ go _ _ _ _ _ _ =+ fromDistinctAscList $+ foldrWithKey+ (\a b ac -> maybe ac (\c -> (a, c) : ac) $ lookup b t1)+ []+ t2 -- | /O(m log n)/ Subtract a map by another via key matching difference :: (Ord k) => Map k a -> Map k b -> Map k a-difference = foldrWithKey (\k _ b -> delete k b)+difference t1 t2 = map empty go go go t1+ where+ go _ _ _ _ _ _ = foldrWithKey (\k _ b -> delete k b) t1 t2 -- | /O(m log n)/ Subtract a map by another, updating bins of matching keys differenceWith@@ -259,20 +338,23 @@ -- | /O(m log n)/ Subtract a map by another, updating bins of matching keys differenceWithKey :: (Ord k) => (k -> a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a-differenceWithKey f t =- foldrWithKey- ( \k b t' ->- maybe- t'- ( \a ->- maybe- (delete k t')- (\a' -> insert k a' t')- $ f k a b- )- $ lookup k t- )- t+differenceWithKey f t1 t2 = map empty go go go t1+ where+ go _ _ _ _ _ _ =+ foldrWithKey+ ( \k b t' ->+ maybe+ t'+ ( \a ->+ maybe+ (delete' k t')+ (\a' -> insert k a' t')+ $ f k a b+ )+ $ lookup k t1+ )+ t1+ t2 -- | /O(n log m)/ Intersect a map with another via left-biased key matching intersection :: (Ord k) => Map k a -> Map k b -> Map k a@@ -285,11 +367,14 @@ -- | /O(n log m)/ Intersect a map with another by key matching, combining values intersectionWithKey :: (Ord k) => (k -> a -> b -> c) -> Map k a -> Map k b -> Map k c-intersectionWithKey f t1 t2 =- foldrWithKey- (\k a c -> maybe c (\b -> insert k (f k a b) c) $ lookup k t2)- empty- t1+intersectionWithKey f t1 t2 = map empty go go go t2+ where+ go _ _ _ _ _ _ =+ fromDistinctAscList $+ foldrWithKey+ (\k a c -> maybe c (\b -> (k, f k a b) : c) $ lookup k t2)+ []+ t1 -- | /O(m log n)/ Unite a map with another via left-biased key matching union :: (Ord k) => Map k a -> Map k a -> Map k a@@ -301,7 +386,9 @@ -- | /O(m log n)/ Unite a map with another, combining values of matching keys unionWithKey :: (Ord k) => (k -> a -> a -> a) -> Map k a -> Map k a -> Map k a-unionWithKey f = flip $ foldrWithKey (insertWithKey f)+unionWithKey f t1 t2 = map t1 go go go t2+ where+ go _ _ _ _ _ _ = foldrWithKey (insertWithKey f) t2 t1 -- | Unite a collection of maps via left-biased key matching unions :: (Foldable t, Ord k) => t (Map k a) -> Map k a@@ -386,29 +473,323 @@ -- | /O(log n)/ Delete a key from a map delete :: (Ord k) => k -> Map k a -> Map k a-delete k0 t = bool t (go t) $ k0 `member` t+delete k t = bool t (delete' k t) $ k `member` t++-- | /O(log n)/ Delete the maximum key from a map+deleteMax :: (Ord k) => Map k a -> Map k a+deleteMax t = maybe t (flip delete' t . fst) $ lookupMax t++-- | /O(log n)/ Delete the minimum key from a map+deleteMin :: (Ord k) => Map k a -> Map k a+deleteMin t = maybe t (flip delete' t . fst) $ lookupMin t++-- | /O(n)/ Keep the bins whose values satisfy a predicate+filter :: (a -> Bool) -> Map k a -> Map k a+filter = filterWithKey . const++-- | /O(n)/ Keep the bins whose keys and values satisfy a predicate+filterWithKey :: (k -> a -> Bool) -> Map k a -> Map k a+filterWithKey p =+ fromDistinctAscList+ . foldrWithKey (\k a b -> bool b ((k, a) : b) $ p k a) []++-- | /O(log n)/ Insert a key and its value into a map, overwriting if present+insert :: (Ord k) => k -> a -> Map k a -> Map k a+insert = insertWithKey $ const const++-- | /O(log n)/ Insert a key and its value, combining new and old if present+insertWith :: (Ord k) => (a -> a -> a) -> k -> a -> Map k a -> Map k a+insertWith = insertWithKey . const++-- | /O(log n)/ Modify the value of a key or delete its bin with an operation+update :: (Ord k) => (a -> Maybe a) -> k -> Map k a -> Map k a+update = updateWithKey . const++-- | /O(log n)/ Modify the value of a key or delete its bin with an operation+updateWithKey :: (Ord k) => (k -> a -> Maybe a) -> k -> Map k a -> Map k a+updateWithKey f k t =+ maybe+ t+ ( maybe+ (delete' k t)+ (\a' -> insert k a' t)+ . f k+ )+ $ lookup k t++-- | /O(log n)/ Modify the value of the maximum key or delete its bin+updateMax :: (Ord k) => (a -> Maybe a) -> Map k a -> Map k a+updateMax = updateMaxWithKey . const++-- | /O(log n)/ Modify the value of the maximum key or delete its bin+updateMaxWithKey :: (Ord k) => (k -> a -> Maybe a) -> Map k a -> Map k a+updateMaxWithKey f t =+ maybe+ t+ ( \(k, a) ->+ maybe+ (delete' k t)+ (\a' -> insert k a' t)+ $ f k a+ )+ $ lookupMax t++-- | /O(log n)/ Modify the value of the minimum key or delete its bin+updateMin :: (Ord k) => (a -> Maybe a) -> Map k a -> Map k a+updateMin = updateMinWithKey . const++-- | /O(log n)/ Modify the value of the minimum key or delete its bin+updateMinWithKey :: (Ord k) => (k -> a -> Maybe a) -> Map k a -> Map k a+updateMinWithKey f t =+ maybe+ t+ ( \(k, a) ->+ maybe+ (delete' k t)+ (\a' -> insert k a' t)+ $ f k a+ )+ $ lookupMin t++{-+ - Partition+ -}++-- | /O(n)/ Partition a map with a predicate into @(true, false)@ submaps+partition :: (a -> Bool) -> Map k a -> (Map k a, Map k a)+partition = partitionWithKey . const++-- | /O(n)/ Partition a map with a predicate into @(true, false)@ submaps+partitionWithKey :: (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)+partitionWithKey p =+ bimap fromDistinctAscList fromDistinctAscList+ . foldrWithKey+ (\k a -> bool second first (p k a) ((k, a) :))+ ([], [])++-- | /O(n)/ Split a map by a key into @(lt, eq, gt)@ submaps+split :: (Ord k) => k -> Map k a -> (Map k a, Maybe a, Map k a)+split k0 =+ (\(lt, a, gt) -> (fromDistinctAscList lt, a, fromDistinctAscList gt))+ . foldrWithKey+ ( \k a (lt, a', gt) -> case compare k k0 of+ LT -> ((k, a) : lt, a', gt)+ EQ -> (lt, Just a, gt)+ GT -> (lt, a', (k, a) : gt)+ )+ ([], Nothing, [])++-- | /O(log n)/ Split a map by its maximum key+splitMax :: (Ord k) => Map k a -> Maybe ((k, a), Map k a)+splitMax t = ((,) <*> flip delete' t . fst) <$> lookupMax t++-- | /O(log n)/ Split a map by its minimum key+splitMin :: (Ord k) => Map k a -> Maybe ((k, a), Map k a)+splitMin t = ((,) <*> flip delete' t . fst) <$> lookupMin t++{-+ - Query+ -}++-- | /O(m log n)/ Check whether two maps have no keys in common+disjoint :: (Ord k) => Map k a -> Map k a -> Bool+disjoint t1 t2 = map True go go go t1 where- go =+ go _ _ _ _ _ _ = not $ foldrWithKey (\k _ b -> k `member` t1 || b) False t2++-- | /O(n log m)/ Check whether the bins of one map exist in the other+isSubmapOf :: (Ord k, Eq a) => Map k a -> Map k a -> Bool+isSubmapOf = isSubmapOfBy (==)++-- | /O(n log m)/ Check if the bins of one map exist in the other by combination+isSubmapOfBy :: (Ord k) => (a -> b -> Bool) -> Map k a -> Map k b -> Bool+isSubmapOfBy p t1 t2 = map (null t1) go go go t2+ where+ go _ _ _ _ _ _ =+ foldrWithKey+ (\k a b -> maybe False ((&& b) . p a) $ lookup k t2)+ True+ t1++-- | /O(log n)/ Fetch the value of a key in a map, or 'Nothing' if absent+lookup :: (Ord k) => k -> Map k a -> Maybe a+lookup k = map Nothing go go go+ where+ go _ k' a _ recl recr = case compare k k' of+ LT -> recl+ EQ -> Just a+ GT -> recr++-- | /O(log n)/ Fetch the least bin greater than or equal to a key+lookupGE :: (Ord k) => k -> Map k a -> Maybe (k, a)+lookupGE k0 = map Nothing go go go+ where+ go _ k a _ recl recr = case compare k k0 of+ LT -> recr+ EQ -> Just (k, a)+ GT -> recl <|> Just (k, a)++-- | /O(log n)/ Fetch the least bin strictly greater than a key+lookupGT :: (Ord k) => k -> Map k a -> Maybe (k, a)+lookupGT k0 = map Nothing go go go+ where+ go _ k a _ recl recr = case compare k k0 of+ LT -> recr+ EQ -> recr+ GT -> recl <|> Just (k, a)++-- | /O(log n)/ Fetch the greatest bin less than or equal to a key+lookupLE :: (Ord k) => k -> Map k a -> Maybe (k, a)+lookupLE k0 = map Nothing go go go+ where+ go _ k a _ recl recr = case compare k k0 of+ LT -> recr <|> Just (k, a)+ EQ -> Just (k, a)+ GT -> recl++-- | /O(log n)/ Fetch the greatest bin strictly less than a key+lookupLT :: (Ord k) => k -> Map k a -> Maybe (k, a)+lookupLT k0 = map Nothing go go go+ where+ go _ k a _ recl recr = case compare k k0 of+ LT -> recr <|> Just (k, a)+ EQ -> recl+ GT -> recl++-- | /O(log n)/ Fetch the bin with the maximum key, or 'Nothing' if empty+lookupMax :: Map k a -> Maybe (k, a)+lookupMax = map Nothing go go go+ where+ go _ k a r _ recr = map (Just (k, a)) go' go' go' r+ where+ go' _ _ _ _ _ _ = recr++-- | /O(log n)/ Fetch the bin with the minimum key, or 'Nothing' if empty+lookupMin :: Map k a -> Maybe (k, a)+lookupMin = map Nothing go go go+ where+ go l k a _ recl _ = map (Just (k, a)) go' go' go' l+ where+ go' _ _ _ _ _ _ = recl++-- | /O(log n)/ Check whether a key is in a map+member :: (Ord k) => k -> Map k a -> Bool+member k0 = map False go go go+ where+ go _ k _ _ recl recr = case compare k0 k of+ LT -> recl+ EQ -> True+ GT -> recr++-- | /O(1)/ Check whether a map is empty+null :: Map k a -> Bool+null = map True go go go where go _ _ _ _ _ _ = False++-- | /O(n)/ Get the size of a map+size :: Map k a -> Int+size = map 0 go go go where go _ _ _ _ recl recr = 1 + recl + recr++{-+ - Traversal+ -}++-- | /O(n)/ Apply an operation across a map, transforming its values+fmapWithKey :: (k -> a -> b) -> Map k a -> Map k b+fmapWithKey f = map E (go L) (go B) (go R)+ where+ go c _ k a _ recl = c recl k (f k a)++-- | /O(n)/ Lift a map with a lifting operation on keys and values+traverseWithKey :: (Applicative f) => (k -> a -> f b) -> Map k a -> f (Map k b)+traverseWithKey f = map (pure E) (go L) (go B) (go R)+ where+ go c _ k a _ recl recr = c <$> recl <*> pure k <*> f k a <*> recr++{-+ - Validation+ -}++-- | /O(n^2)/ Check whether a map is internally height-balanced and ordered+valid :: (Ord k) => Map k a -> Bool+valid = liftA2 (&&) balanced ordered+ where+ balanced = map- (error "Map.delete: L0")- ( \l k a r _ _ ->- case compare k0 k of- LT -> deleteLl l k a r- EQ -> substituteL l r- GT -> deleteLr l k a r- )- ( \l k a r _ _ ->- case compare k0 k of- LT -> deleteBl l k a r- EQ -> substituteBr l r- GT -> deleteBr l k a r- )- ( \l k a r _ _ ->- case compare k0 k of- LT -> deleteRl l k a r- EQ -> substituteR l r- GT -> deleteRr l k a r- )+ True+ (\l _ _ r recl recr -> levels l - levels r == 1 && recl && recr)+ (\l _ _ r recl recr -> levels l - levels r == 0 && recl && recr)+ (\l _ _ r recl recr -> levels r - levels l == 1 && recl && recr)+ levels = map 0 go go go+ where+ go _ _ _ _ recl recr = 1 + max recl recr :: Int+ ordered = map True go go go+ where+ go l k _ r recl recr =+ map True lt lt lt l+ && map True gt gt gt r+ where+ lt _ lk _ _ _ _ = lk < k && recl && recr+ gt _ rk _ _ _ _ = rk > k && recl && recr++{-+ - Helpers+ -}++-- O(n) 'nub' on keys for sorted lists of pairs+essence :: (Eq k) => [(k, a)] -> [(k, a)]+essence [] = []+essence (x : xs) = essence' x xs+ where+ essence' ka1 [] = [ka1]+ essence' ka1@(k1, _) (ka2@(k2, _) : kas) =+ let rest = essence' ka2 kas+ in bool (ka1 : rest) rest $ k1 == k2++-- O(n) 'nub' with a combining function for sorted lists of pairs+essenceWith :: (Eq k) => (k -> a -> a -> a) -> [(k, a)] -> [(k, a)]+essenceWith _ [] = []+essenceWith f (x : xs) = essenceWith' x xs+ where+ essenceWith' ka1 [] = [ka1]+ essenceWith' ka1@(k1, a1) (ka2@(k2, a2) : kas) =+ bool+ (ka1 : essenceWith' ka2 kas)+ (essenceWith' (k1, f k1 a2 a1) kas)+ $ k1 == k2++-- The greatest power of 2 <= the length of a non-empty collection+power :: (Foldable t) => t a -> Int+power as = until (> length as) (* 2) 2 `div` 2++{-+ - Let this comment serve as your warning. Return from whence you came and your+ - sanity will be spared. You have been admonished.+ -}++-- O(log n) Delete a key from a map without checking for membership+delete' :: (Ord k) => k -> Map k a -> Map k a+delete' k0 =+ map+ (error "Map.delete: L0")+ ( \l k a r _ _ ->+ case compare k0 k of+ LT -> deleteLl l k a r+ EQ -> substituteL l r+ GT -> deleteLr l k a r+ )+ ( \l k a r _ _ ->+ case compare k0 k of+ LT -> deleteBl l k a r+ EQ -> substituteBr l r+ GT -> deleteBr l k a r+ )+ ( \l k a r _ _ ->+ case compare k0 k of+ LT -> deleteRl l k a r+ EQ -> substituteR l r+ GT -> deleteRr l k a r+ )+ where deleteRl l k a r = map (error "Map.delete: L1")@@ -880,31 +1261,7 @@ (\(r, k', a') -> (checkRightB l k a r, k', a')) $ popRightL rl rk ra rr --- | /O(log n)/ Delete the maximum key from a map-deleteMax :: (Ord k) => Map k a -> Map k a-deleteMax t = maybe t (flip delete t . fst) $ lookupMax t---- | /O(log n)/ Delete the minimum key from a map-deleteMin :: (Ord k) => Map k a -> Map k a-deleteMin t = maybe t (flip delete t . fst) $ lookupMin t---- | /O(n log n)/ Keep the bins whose values satisfy a predicate-filter :: (Ord k) => (a -> Bool) -> Map k a -> Map k a-filter = filterWithKey . const---- | /O(n log n)/ Keep the bins whose keys and values satisfy a predicate-filterWithKey :: (Ord k) => (k -> a -> Bool) -> Map k a -> Map k a-filterWithKey p = foldrWithKey (\k a b -> bool b (insert k a b) $ p k a) empty---- | /O(log n)/ Insert a key and its value into a map, overwriting if present-insert :: (Ord k) => k -> a -> Map k a -> Map k a-insert = insertWithKey $ const const- -- | /O(log n)/ Insert a key and its value, combining new and old if present-insertWith :: (Ord k) => (a -> a -> a) -> k -> a -> Map k a -> Map k a-insertWith = insertWithKey . const---- | /O(log n)/ Insert a key and its value, combining new and old if present insertWithKey :: (Ord k) => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a insertWithKey f k0 a0 = map@@ -1092,230 +1449,6 @@ ) (\lrl lrk lra lrr _ _ -> L (B ll lk la (insertR lrl lrk lra lrr)) k a r) lr---- | /O(log n)/ Modify the value of a key or delete its bin with an operation-update :: (Ord k) => (a -> Maybe a) -> k -> Map k a -> Map k a-update = updateWithKey . const---- | /O(log n)/ Modify the value of a key or delete its bin with an operation-updateWithKey :: (Ord k) => (k -> a -> Maybe a) -> k -> Map k a -> Map k a-updateWithKey f k t =- maybe- t- ( maybe- (delete k t)- (\a' -> insert k a' t)- . f k- )- $ lookup k t---- | /O(log n)/ Modify the value of the maximum key or delete its bin-updateMax :: (Ord k) => (a -> Maybe a) -> Map k a -> Map k a-updateMax = updateMaxWithKey . const---- | /O(log n)/ Modify the value of the maximum key or delete its bin-updateMaxWithKey :: (Ord k) => (k -> a -> Maybe a) -> Map k a -> Map k a-updateMaxWithKey f t =- maybe- t- ( \(k, a) ->- maybe- (delete k t)- (\a' -> insert k a' t)- $ f k a- )- $ lookupMax t---- | /O(log n)/ Modify the value of the minimum key or delete its bin-updateMin :: (Ord k) => (a -> Maybe a) -> Map k a -> Map k a-updateMin = updateMinWithKey . const---- | /O(log n)/ Modify the value of the minimum key or delete its bin-updateMinWithKey :: (Ord k) => (k -> a -> Maybe a) -> Map k a -> Map k a-updateMinWithKey f t =- maybe- t- ( \(k, a) ->- maybe- (delete k t)- (\a' -> insert k a' t)- $ f k a- )- $ lookupMin t--{-- - Partition- -}---- | /O(n log n)/ Partition a map with a predicate into @(true, false)@ submaps-partition :: (Ord k) => (a -> Bool) -> Map k a -> (Map k a, Map k a)-partition = partitionWithKey . const---- | /O(n log n)/ Partition a map with a predicate into @(true, false)@ submaps-partitionWithKey :: (Ord k) => (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)-partitionWithKey p =- foldrWithKey- (\k a (t1, t2) -> bool (t1, insert k a t2) (insert k a t1, t2) $ p k a)- (empty, empty)---- | /O(n log n)/ Split a map by a key into @(lt, eq, gt)@ submaps-split :: (Ord k) => k -> Map k a -> (Map k a, Maybe a, Map k a)-split k0 =- foldrWithKey- ( \k a (t1, a', t2) -> case compare k k0 of- LT -> (insert k a t1, a', t2)- EQ -> (t1, Just a, t2)- GT -> (t1, a', insert k a t2)- )- (empty, Nothing, empty)---- | /O(log n)/ Split a map by its maximum key-splitMax :: (Ord k) => Map k a -> Maybe ((k, a), Map k a)-splitMax t = (,deleteMax t) <$> lookupMax t---- | /O(log n)/ Split a map by its minimum key-splitMin :: (Ord k) => Map k a -> Maybe ((k, a), Map k a)-splitMin t = (,deleteMin t) <$> lookupMin t--{-- - Query- -}---- | /O(m log n)/ Check whether two maps have no keys in common-disjoint :: (Ord k) => Map k a -> Map k a -> Bool-disjoint t1 = not . foldrWithKey (\k _ b -> k `member` t1 || b) False---- | /O(n log m)/ Check whether the bins of one map exist in the other-isSubmapOf :: (Ord k, Eq a) => Map k a -> Map k a -> Bool-isSubmapOf = isSubmapOfBy (==)---- | /O(n log m)/ Check if the bins of one map exist in the other by combination-isSubmapOfBy :: (Ord k) => (a -> b -> Bool) -> Map k a -> Map k b -> Bool-isSubmapOfBy p t1 t2 =- foldrWithKey- (\k a b -> maybe False ((&& b) . p a) $ lookup k t2)- True- t1---- | /O(log n)/ Fetch the value of a key in a map, or 'Nothing' if absent-lookup :: (Ord k) => k -> Map k a -> Maybe a-lookup k = map Nothing go go go- where- go _ k' a _ recl recr = case compare k k' of- LT -> recl- EQ -> Just a- GT -> recr---- | /O(log n)/ Fetch the least bin greater than or equal to a key-lookupGE :: (Ord k) => k -> Map k a -> Maybe (k, a)-lookupGE k0 = map Nothing go go go- where- go _ k a _ recl recr = case compare k k0 of- LT -> recr- EQ -> Just (k, a)- GT -> recl <|> Just (k, a)---- | /O(log n)/ Fetch the least bin strictly greater than a key-lookupGT :: (Ord k) => k -> Map k a -> Maybe (k, a)-lookupGT k0 = map Nothing go go go- where- go _ k a _ recl recr = case compare k k0 of- LT -> recr- EQ -> recr- GT -> recl <|> Just (k, a)---- | /O(log n)/ Fetch the greatest bin less than or equal to a key-lookupLE :: (Ord k) => k -> Map k a -> Maybe (k, a)-lookupLE k0 = map Nothing go go go- where- go _ k a _ recl recr = case compare k k0 of- LT -> recr <|> Just (k, a)- EQ -> Just (k, a)- GT -> recl---- | /O(log n)/ Fetch the greatest bin strictly less than a key-lookupLT :: (Ord k) => k -> Map k a -> Maybe (k, a)-lookupLT k0 = map Nothing go go go- where- go _ k a _ recl recr = case compare k k0 of- LT -> recr <|> Just (k, a)- EQ -> recl- GT -> recl---- | /O(log n)/ Fetch the bin with the maximum key, or 'Nothing' if empty-lookupMax :: Map k a -> Maybe (k, a)-lookupMax = map Nothing go go go- where- go _ k a r _ recr = map (Just (k, a)) go' go' go' r- where- go' _ _ _ _ _ _ = recr---- | /O(log n)/ Fetch the bin with the minimum key, or 'Nothing' if empty-lookupMin :: Map k a -> Maybe (k, a)-lookupMin = map Nothing go go go- where- go l k a _ recl _ = map (Just (k, a)) go' go' go' l- where- go' _ _ _ _ _ _ = recl---- | /O(log n)/ Check whether a key is in a map-member :: (Ord k) => k -> Map k a -> Bool-member k0 = map False go go go- where- go _ k _ _ recl recr = case compare k0 k of- LT -> recl- EQ -> True- GT -> recr---- | /O(1)/ Check whether a map is empty-null :: Map k a -> Bool-null = map True go go go where go _ _ _ _ _ _ = False---- | /O(n)/ Get the size of a map-size :: Map k a -> Int-size = map 0 go go go where go _ _ _ _ recl recr = 1 + recl + recr--{-- - Traversal- -}---- | /O(n)/ Apply an operation across a map, transforming its values-fmapWithKey :: (k -> a -> b) -> Map k a -> Map k b-fmapWithKey f = map E (go L) (go B) (go R)- where- go c _ k a _ recl = c recl k (f k a)---- | /O(n)/ Lift a map with a lifting operation on keys and values-traverseWithKey :: (Applicative f) => (k -> a -> f b) -> Map k a -> f (Map k b)-traverseWithKey f = map (pure E) (go L) (go B) (go R)- where- go c _ k a _ recl recr = c <$> recl <*> pure k <*> f k a <*> recr--{-- - Validation- -}---- | /O(n)/ Check whether a map is internally height-balanced and ordered-valid :: (Ord k) => Map k a -> Bool-valid = liftA2 (&&) balanced ordered- where- balanced =- map- True- (\l _ _ r recl recr -> levels l - levels r == 1 && recl && recr)- (\l _ _ r recl recr -> levels l - levels r == 0 && recl && recr)- (\l _ _ r recl recr -> levels r - levels l == 1 && recl && recr)- levels = map 0 go go go- where- go _ _ _ _ recl recr = 1 + max recl recr :: Int- ordered = map True go go go- where- go l k _ r recl recr =- map True lt lt lt l- && map True gt gt gt r- where- lt _ lk _ _ _ _ = lk < k && recl && recr- gt _ rk _ _ _ _ = rk > k && recl && recr {- - Examples
Mini/Data/Set.hs view
@@ -1,4 +1,6 @@ {-# LANGUAGE TupleSections #-}+-- incomplete patterns in 'from{Asc,Desc}List'+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -- | A structure containing unique elements module Mini.Data.Set (@@ -7,8 +9,12 @@ -- * Construction empty,- fromList, singleton,+ fromList,+ fromAscList,+ fromDescList,+ fromDistinctAscList,+ fromDistinctDescList, -- * Combination difference,@@ -55,11 +61,16 @@ (<|>), ) import Data.Bifunctor (+ bimap, first,+ second, ) import Data.Bool ( bool, )+import Data.Function (+ on,+ ) import Prelude ( Bool ( False,@@ -81,25 +92,32 @@ ), Semigroup, Show,+ all, any, compare,+ div, error, flip, foldl, foldr,+ length, max, maybe, mempty, not, show,+ splitAt, uncurry,+ until, ($), (&&),+ (*), (+), (-), (.), (<), (<$>),+ (<*>), (<>), (==), (>),@@ -121,10 +139,10 @@ R (Set a) a (Set a) instance (Eq a) => Eq (Set a) where- t1 == t2 = toAscList t1 == toAscList t2+ (==) = (==) `on` toAscList instance (Ord a) => Ord (Set a) where- compare t1 t2 = compare (toAscList t1) (toAscList t2)+ compare = compare `on` toAscList instance (Show a) => Show (Set a) where show = show . toAscList@@ -170,33 +188,74 @@ empty :: Set a empty = E +-- | /O(1)/ Make a set with a single element+singleton :: a -> Set a+singleton a = B E a E+ -- | /O(n log n)/ Make a set from a list of elements fromList :: (Ord a) => [a] -> Set a fromList = foldl (flip insert) empty --- | /O(1)/ Make a set with a single element-singleton :: a -> Set a-singleton a = B E a E+-- | /O(n)/ Make a set from a sorted list of elements+fromAscList :: (Eq a) => [a] -> Set a+fromAscList = fromDistinctAscList . essence +-- | /O(n)/ Make a set from a sorted list of elements+fromDescList :: (Eq a) => [a] -> Set a+fromDescList = fromDistinctDescList . essence++-- | /O(n)/ Make a set from a sorted list of distinct elements+fromDistinctAscList :: [a] -> Set a+fromDistinctAscList = go <*> power+ where+ go [] _ = E+ go [a] _ = B E a E+ go as n =+ let len = length as+ n' = n `div` 2+ c = bool B L $ len == n+ (l, a : r) = splitAt (len `div` 2) as+ in c (go l n') a (go r n')++-- | /O(n)/ Make a set from a sorted list of distinct elements+fromDistinctDescList :: [a] -> Set a+fromDistinctDescList = go <*> power+ where+ go [] _ = E+ go [a] _ = B E a E+ go as n =+ let len = length as+ n' = n `div` 2+ c = bool B R $ len == n+ (l, a : r) = splitAt (len `div` 2) as+ in c (go r n') a (go l n')+ {- - Combination -} -- | /O(m log n)/ Subtract a set by another difference :: (Ord a) => Set a -> Set a -> Set a-difference = foldr delete+difference t1 t2 = set empty go go go t1+ where+ go _ _ _ _ _ = foldr delete t1 t2 -- | /O(m log n)/ Intersect a set with another intersection :: (Ord a) => Set a -> Set a -> Set a-intersection t1 t2 =- foldr- (\a b -> bool b (insert a b) (a `member` t2))- empty- t1+intersection t1 t2 = set empty go go go t2+ where+ go _ _ _ _ _ =+ fromDistinctAscList $+ foldr+ (\a b -> bool b (a : b) $ a `member` t2)+ []+ t1 -- | /O(m log n)/ Unite a set with another union :: (Ord a) => Set a -> Set a -> Set a-union = flip $ foldr insert+union t1 t2 = set t2 go go go t1+ where+ go _ _ _ _ _ = foldr insert t1 t2 -- | Unite a collection of sets unions :: (Foldable t, Ord a) => t (Set a) -> Set a@@ -220,29 +279,214 @@ -- | /O(log n)/ Delete an element from a set delete :: (Ord a) => a -> Set a -> Set a-delete a0 t = bool t (go t) (a0 `member` t)+delete a t = bool t (delete' a t) $ a `member` t++-- | /O(log n)/ Delete the maximum element from a set+deleteMax :: (Ord a) => Set a -> Set a+deleteMax t = maybe t (`delete'` t) $ lookupMax t++-- | /O(log n)/ Delete the minimum element from a set+deleteMin :: (Ord a) => Set a -> Set a+deleteMin t = maybe t (`delete'` t) $ lookupMin t++-- | /O(n)/ Keep the elements satisfying a predicate+filter :: (a -> Bool) -> Set a -> Set a+filter p = fromDistinctAscList . foldr (\a b -> bool b (a : b) $ p a) []++-- | /O(log n)/ Insert an element into a set+insert :: (Ord a) => a -> Set a -> Set a+insert a t = bool (insert' a t) t $ a `member` t++{-+ - Partition+ -}++-- | /O(n)/ Partition a set with a predicate into @(true, false)@ subsets+partition :: (a -> Bool) -> Set a -> (Set a, Set a)+partition p =+ bimap fromDistinctAscList fromDistinctAscList+ . foldr+ (\a -> bool second first (p a) (a :))+ ([], [])++-- | /O(n)/ Split a set by an element into @(lt, eq, gt)@ subsets+split :: (Ord a) => a -> Set a -> (Set a, Bool, Set a)+split a0 =+ (\(lt, a, gt) -> (fromDistinctAscList lt, a, fromDistinctAscList gt))+ . foldr+ ( \a (lt, a', gt) -> case compare a a0 of+ LT -> (a : lt, a', gt)+ EQ -> (lt, True, gt)+ GT -> (lt, a', a : gt)+ )+ ([], False, [])++-- | /O(log n)/ Split a set by its maximum element+splitMax :: (Ord a) => Set a -> Maybe (a, Set a)+splitMax t = ((,) <*> flip delete' t) <$> lookupMax t++-- | /O(log n)/ Split a set by its minimum element+splitMin :: (Ord a) => Set a -> Maybe (a, Set a)+splitMin t = ((,) <*> flip delete' t) <$> lookupMin t++{-+ - Query+ -}++-- | /O(m log n)/ Check whether two sets have no elements in common+disjoint :: (Ord a) => Set a -> Set a -> Bool+disjoint t1 t2 = set True go go go t1 where- go =+ go _ _ _ _ _ = not $ any (`member` t1) t2++-- | /O(n log m)/ Check whether the elements of a set exist in the other+isSubsetOf :: (Ord a) => Set a -> Set a -> Bool+isSubsetOf t1 t2 = set (null t1) go go go t2+ where+ go _ _ _ _ _ = all (`member` t2) t1++-- | /O(log n)/ Fetch the least element greater than or equal to the given one+lookupGE :: (Ord a) => a -> Set a -> Maybe a+lookupGE a0 = set Nothing go go go+ where+ go _ a _ recl recr = case compare a a0 of+ LT -> recr+ EQ -> Just a+ GT -> recl <|> Just a++-- | /O(log n)/ Fetch the least element strictly greater than the given one+lookupGT :: (Ord a) => a -> Set a -> Maybe a+lookupGT a0 = set Nothing go go go+ where+ go _ a _ recl recr = case compare a a0 of+ LT -> recr+ EQ -> recr+ GT -> recl <|> Just a++-- | /O(log n)/ Fetch the greatest element less than or equal to the given one+lookupLE :: (Ord a) => a -> Set a -> Maybe a+lookupLE a0 = set Nothing go go go+ where+ go _ a _ recl recr = case compare a a0 of+ LT -> recr <|> Just a+ EQ -> Just a+ GT -> recl++-- | /O(log n)/ Fetch the greatest element strictly less than the given one+lookupLT :: (Ord a) => a -> Set a -> Maybe a+lookupLT a0 = set Nothing go go go+ where+ go _ a _ recl recr = case compare a a0 of+ LT -> recr <|> Just a+ EQ -> recl+ GT -> recl++-- | /O(log n)/ Fetch the maximum element, or 'Nothing' if the set is empty+lookupMax :: Set a -> Maybe a+lookupMax = set Nothing go go go+ where+ go _ a r _ recr = set (Just a) go' go' go' r+ where+ go' _ _ _ _ _ = recr++-- | /O(log n)/ Fetch the minimum element, or 'Nothing' if the set is empty+lookupMin :: Set a -> Maybe a+lookupMin = set Nothing go go go+ where+ go l a _ recl _ = set (Just a) go' go' go' l+ where+ go' _ _ _ _ _ = recl++-- | /O(log n)/ Check whether an element is in a set+member :: (Ord a) => a -> Set a -> Bool+member a0 = set False go go go+ where+ go _ a _ recl recr = case compare a0 a of+ LT -> recl+ EQ -> True+ GT -> recr++-- | /O(1)/ Check whether a set is empty+null :: Set a -> Bool+null = set True go go go where go _ _ _ _ _ = False++-- | /O(n)/ Get the size of a set+size :: Set a -> Int+size = set 0 go go go where go _ _ _ recl recr = 1 + recl + recr++{-+ - Validation+ -}++-- | /O(n^2)/ Check whether a set is internally height-balanced and ordered+valid :: (Ord a) => Set a -> Bool+valid = liftA2 (&&) balanced ordered+ where+ balanced = set- (error "Set.delete: L0")- ( \l a r _ _ ->- case compare a0 a of- LT -> deleteLl l a r- EQ -> substituteL l r- GT -> deleteLr l a r- )- ( \l a r _ _ ->- case compare a0 a of- LT -> deleteBl l a r- EQ -> substituteBr l r- GT -> deleteBr l a r- )- ( \l a r _ _ ->- case compare a0 a of- LT -> deleteRl l a r- EQ -> substituteR l r- GT -> deleteRr l a r- )+ True+ (\l _ r recl recr -> levels l - levels r == 1 && recl && recr)+ (\l _ r recl recr -> levels l - levels r == 0 && recl && recr)+ (\l _ r recl recr -> levels r - levels l == 1 && recl && recr)+ levels = set 0 go go go+ where+ go _ _ _ recl recr = 1 + max recl recr :: Int+ ordered = set True go go go+ where+ go l a r recl recr =+ set True lt lt lt l+ && set True gt gt gt r+ where+ lt _ la _ _ _ = la < a && recl && recr+ gt _ ra _ _ _ = ra > a && recl && recr++{-+ - Helpers+ -}++-- O(n) 'nub' for sorted lists+essence :: (Eq a) => [a] -> [a]+essence [] = []+essence (a : as) = essence' a as+ where+ essence' x1 [] = [x1]+ essence' x1 (x2 : xs) =+ let rest = essence' x2 xs+ in bool (x1 : rest) rest $ x1 == x2++-- The greatest power of 2 <= the length of a non-empty collection+power :: (Foldable t) => t a -> Int+power as = until (> length as) (* 2) 2 `div` 2++{-+ - Let this comment serve as your warning. Return from whence you came and your+ - sanity will be spared. You have been admonished.+ -}++-- O(log n) Delete an element from a set without checking for membership+delete' :: (Ord a) => a -> Set a -> Set a+delete' a0 =+ set+ (error "Set.delete: L0")+ ( \l a r _ _ ->+ case compare a0 a of+ LT -> deleteLl l a r+ EQ -> substituteL l r+ GT -> deleteLr l a r+ )+ ( \l a r _ _ ->+ case compare a0 a of+ LT -> deleteBl l a r+ EQ -> substituteBr l r+ GT -> deleteBr l a r+ )+ ( \l a r _ _ ->+ case compare a0 a of+ LT -> deleteRl l a r+ EQ -> substituteR l r+ GT -> deleteRr l a r+ )+ where deleteRl l a r = set (error "Set.delete: L1")@@ -635,21 +879,9 @@ popRightBR l a rl ra rr = first (checkRightB l a) $ popRightR rl ra rr popRightBL l a rl ra rr = first (checkRightB l a) $ popRightL rl ra rr --- | /O(log n)/ Delete the maximum element from a set-deleteMax :: (Ord a) => Set a -> Set a-deleteMax t = maybe t (`delete` t) $ lookupMax t---- | /O(log n)/ Delete the minimum element from a set-deleteMin :: (Ord a) => Set a -> Set a-deleteMin t = maybe t (`delete` t) $ lookupMin t---- | /O(n log n)/ Keep the elements satisfying a predicate-filter :: (Ord a) => (a -> Bool) -> Set a -> Set a-filter p = foldr (\a b -> bool b (insert a b) $ p a) empty---- | /O(log n)/ Insert an element into a set-insert :: (Ord a) => a -> Set a -> Set a-insert a0 =+-- O(log n) Insert an element into a set without checking for membership+insert' :: (Ord a) => a -> Set a -> Set a+insert' a0 = set (B E a0 E) (\l a r _ _ -> insertL l a r)@@ -811,140 +1043,3 @@ ) (\lrl lra lrr _ _ -> L (B ll la (insertR lrl lra lrr)) a r) lr--{-- - Partition- -}---- | /O(n log n)/ Partition a set with a predicate into @(true, false)@ subsets-partition :: (Ord a) => (a -> Bool) -> Set a -> (Set a, Set a)-partition p =- foldr- (\a (t1, t2) -> bool (t1, insert a t2) (insert a t1, t2) $ p a)- (empty, empty)---- | /O(n log n)/ Split a set by an element into @(lt, eq, gt)@ subsets-split :: (Ord a) => a -> Set a -> (Set a, Bool, Set a)-split a0 =- foldr- ( \a (t1, a', t2) -> case compare a a0 of- LT -> (insert a t1, a', t2)- EQ -> (t1, True, t2)- GT -> (t1, a', insert a t2)- )- (empty, False, empty)---- | /O(log n)/ Split a set by its maximum element-splitMax :: (Ord a) => Set a -> Maybe (a, Set a)-splitMax t = (,deleteMax t) <$> lookupMax t---- | /O(log n)/ Split a set by its minimum element-splitMin :: (Ord a) => Set a -> Maybe (a, Set a)-splitMin t = (,deleteMin t) <$> lookupMin t--{-- - Query- -}---- | /O(m log n)/ Check whether two sets have no elements in common-disjoint :: (Ord a) => Set a -> Set a -> Bool-disjoint t1 = not . any (`member` t1)---- | /O(n log m)/ Check whether the elements of a set exist in the other-isSubsetOf :: (Ord a) => Set a -> Set a -> Bool-isSubsetOf t1 t2 = foldr (\a b -> a `member` t2 && b) True t1---- | /O(log n)/ Fetch the least element greater than or equal to the given one-lookupGE :: (Ord a) => a -> Set a -> Maybe a-lookupGE a0 = set Nothing go go go- where- go _ a _ recl recr = case compare a a0 of- LT -> recr- EQ -> Just a- GT -> recl <|> Just a---- | /O(log n)/ Fetch the least element strictly greater than the given one-lookupGT :: (Ord a) => a -> Set a -> Maybe a-lookupGT a0 = set Nothing go go go- where- go _ a _ recl recr = case compare a a0 of- LT -> recr- EQ -> recr- GT -> recl <|> Just a---- | /O(log n)/ Fetch the greatest element less than or equal to the given one-lookupLE :: (Ord a) => a -> Set a -> Maybe a-lookupLE a0 = set Nothing go go go- where- go _ a _ recl recr = case compare a a0 of- LT -> recr <|> Just a- EQ -> Just a- GT -> recl---- | /O(log n)/ Fetch the greatest element strictly less than the given one-lookupLT :: (Ord a) => a -> Set a -> Maybe a-lookupLT a0 = set Nothing go go go- where- go _ a _ recl recr = case compare a a0 of- LT -> recr <|> Just a- EQ -> recl- GT -> recl---- | /O(log n)/ Fetch the maximum element, or 'Nothing' if the set is empty-lookupMax :: Set a -> Maybe a-lookupMax = set Nothing go go go- where- go _ a r _ recr = set (Just a) go' go' go' r- where- go' _ _ _ _ _ = recr---- | /O(log n)/ Fetch the minimum element, or 'Nothing' if the set is empty-lookupMin :: Set a -> Maybe a-lookupMin = set Nothing go go go- where- go l a _ recl _ = set (Just a) go' go' go' l- where- go' _ _ _ _ _ = recl---- | /O(log n)/ Check whether an element is in a set-member :: (Ord a) => a -> Set a -> Bool-member a0 = set False go go go- where- go _ a _ recl recr = case compare a0 a of- LT -> recl- EQ -> True- GT -> recr---- | /O(1)/ Check whether a set is empty-null :: Set a -> Bool-null = set True go go go where go _ _ _ _ _ = False---- | /O(n)/ Get the size of a set-size :: Set a -> Int-size = set 0 go go go where go _ _ _ recl recr = 1 + recl + recr--{-- - Validation- -}---- | /O(n)/ Check whether a set is internally height-balanced and ordered-valid :: (Ord a) => Set a -> Bool-valid = liftA2 (&&) balanced ordered- where- balanced =- set- True- (\l _ r recl recr -> levels l - levels r == 1 && recl && recr)- (\l _ r recl recr -> levels l - levels r == 0 && recl && recr)- (\l _ r recl recr -> levels r - levels l == 1 && recl && recr)- levels = set 0 go go go- where- go _ _ _ recl recr = 1 + max recl recr :: Int- ordered = set True go go go- where- go l a r recl recr =- set True lt lt lt l- && set True gt gt gt r- where- lt _ la _ _ _ = la < a && recl && recr- gt _ ra _ _ _ = ra > a && recl && recr
mini.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: mini-version: 1.5.3.0+version: 1.5.4.0 license: MIT license-file: LICENSE author: Victor Wallsten <victor.wallsten@protonmail.com>