packages feed

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 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>