pomaps 0.0.0.4 → 0.0.1.0

raw patch · 15 files changed

+903/−820 lines, 15 filesdep ~containers

Dependency ranges changed: containers

Files

CHANGELOG.md +7/−7
README.md +0/−16
bench/Main.hs +77/−77
lattices/Algebra/PartialOrd.hs +154/−154
pomaps.cabal +5/−6
src/Data/POMap/Internal.hs +42/−2
src/Data/POMap/Lazy.hs +4/−0
src/Data/POMap/Strict.hs +4/−0
src/Data/POSet.hs +117/−117
src/Data/POSet/Internal.hs +397/−356
stack.yaml +63/−63
tests/Data/POMap/Properties.hs +14/−3
tests/Data/POMap/Strictness.hs +1/−1
tests/Main.hs +13/−13
tests/doctest-driver.hs +5/−5

CHANGELOG.md view

@@ -1,7 +1,7 @@-# Change log
-
-`pomaps` follows the [PVP][1].
-The change log is available [on GitHub][2].
-
-[1]: https://pvp.haskell.org/
-[2]: https://github.com/sgraf812/pomaps/releases
+# Change log++`pomaps` follows the [PVP][1].+The change log is available [on GitHub][2].++[1]: https://pvp.haskell.org/+[2]: https://github.com/sgraf812/pomaps/releases

− README.md

@@ -1,16 +0,0 @@-# [`pomaps`][pomaps] [![Build Status](https://travis-ci.org/sgraf812/pomaps.svg?branch=master)](https://travis-ci.org/sgraf812/pomaps) [![Hackage](https://img.shields.io/hackage/v/pomaps.svg)](https://hackage.haskell.org/package/pomaps)
-
-Reasonably fast maps (and possibly sets) based on keys satisfying [`PartialOrd`](https://hackage.haskell.org/package/lattices-1.6.0/docs/Algebra-PartialOrd.html#t:PartialOrd).
-
-This package tries to load off as much work as possible to the excellent [`containers`](https://hackage.haskell.org/package/containers) library, in order to achieve acceptable performance.
-The interface is kept as similar to [`Data.Map.{Strict,Lazy}`](https://hackage.haskell.org/package/containers/docs/Data-Map-Strict.html) as possible, which is an excuse for somewhat lacking documentation.
-
-`POMap`s basically store a decomposition of totally ordered chains (e.g. something `Map`s can handle).
-Functionality and strictness properties should be pretty much covered by the testsuite.
-But it's not battle-tested yet, so if you encounter space leaks in the implementation, let me know.
-
-A rather naive implementation leads to `O(w*n*log n)` lookups, where `w` is the width of the decomposition (which should be the size of the biggest anti-chain).
-This is enough for me at the moment to get things going, but there is room for improvement ([Sorting and Selection in Posets](https://arxiv.org/abs/0707.1532)).
-Let me know if things are too slow and I'll see what I can do!
-
-[pomaps]: https://github.com/sgraf812/pomaps

bench/Main.hs view

@@ -1,77 +1,77 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-
-import           Algebra.PartialOrd
-import           Control.Arrow      (first)
-import           Control.DeepSeq
-import           Criterion.Main
-import qualified Data.POMap.Lazy    as L
-import qualified Data.POMap.Strict  as S
-import qualified Data.Vector        as V
-import           System.Random
-
-newtype Divisibility
-  = Div { _unDiv :: Int }
-  deriving (Eq, Num, Show, Read, NFData)
-
-instance PartialOrd Divisibility where
-  leq (Div a) (Div b) = b `mod` a == 0
-
-instance Bounded Divisibility where
-  minBound = Div 1
-  maxBound = Div maxBound
-
-instance Random Divisibility where
-  randomR (Div l, Div h) = first Div . randomR (l, h)
-  random = randomR (minBound, maxBound)
-
-genElems :: Int -> [(Divisibility, Int)]
-genElems n = zip (randoms (mkStdGen 0) :: [Divisibility]) [1 :: Int .. n]
-
-main :: IO ()
-main = defaultMain
-  [ bgroup "insert"
-      [ bgroup s
-          [ env
-            (pure (genElems n))
-            (bench (show n) . whnf (foldr (uncurry insert) L.empty))
-          | n <- [100, 1000, 2000]
-          ]
-      | (s, insert) <- [("Lazy", L.insert), ("Strict", S.insert)]
-      ]
-  , bgroup "lookup(present)"
-      [ env
-        (let elems = genElems n
-             m = L.fromList elems
-             k = fst (elems !! (length elems `div` 2))
-         in pure (m, k))
-        (\ ~(m, k) -> bench (show n) (whnf (L.lookup k) m))
-      | n <- [100, 1000, 2000]
-      ]
-  , bgroup "lookup(absent)"
-      [ env
-        (let elems = genElems n
-             m = L.fromList elems
-             k = fst (random (mkStdGen (-1)))
-         in pure (m, k))
-        (\ ~(m, k) -> bench (show n) (whnf (L.lookup k) m))
-      | n <- [100, 1000, 2000]
-      ]
-  , bgroup "Vector.lookup(present)"
-      [ env
-        (let elems = genElems n
-             v = V.fromListN n elems
-             k = fst (elems !! (length elems `div` 2))
-         in pure (v, k))
-        (\ ~(v, k) -> bench (show n) (whnf (V.find ((== k) . fst)) v))
-      | n <- [100, 1000, 2000]
-      ]
-  , bgroup "Vector.lookup(absent)"
-      [ env
-        (let elems = genElems n
-             v = V.fromListN n elems
-             k = fst (random (mkStdGen (-1)))
-         in pure (v, k))
-        (\ ~(v, k) -> bench (show n) (whnf (V.find ((== k) . fst)) v))
-      | n <- [100, 1000, 2000]
-      ]
-  ]
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++import           Algebra.PartialOrd+import           Control.Arrow      (first)+import           Control.DeepSeq+import           Criterion.Main+import qualified Data.POMap.Lazy    as L+import qualified Data.POMap.Strict  as S+import qualified Data.Vector        as V+import           System.Random++newtype Divisibility+  = Div { _unDiv :: Int }+  deriving (Eq, Num, Show, Read, NFData)++instance PartialOrd Divisibility where+  leq (Div a) (Div b) = b `mod` a == 0++instance Bounded Divisibility where+  minBound = Div 1+  maxBound = Div maxBound++instance Random Divisibility where+  randomR (Div l, Div h) = first Div . randomR (l, h)+  random = randomR (minBound, maxBound)++genElems :: Int -> [(Divisibility, Int)]+genElems n = zip (randoms (mkStdGen 0) :: [Divisibility]) [1 :: Int .. n]++main :: IO ()+main = defaultMain+  [ bgroup "insert"+      [ bgroup s+          [ env+            (pure (genElems n))+            (bench (show n) . whnf (foldr (uncurry insert) L.empty))+          | n <- [100, 1000, 2000]+          ]+      | (s, insert) <- [("Lazy", L.insert), ("Strict", S.insert)]+      ]+  , bgroup "lookup(present)"+      [ env+        (let elems = genElems n+             m = L.fromList elems+             k = fst (elems !! (length elems `div` 2))+         in pure (m, k))+        (\ ~(m, k) -> bench (show n) (whnf (L.lookup k) m))+      | n <- [100, 1000, 2000]+      ]+  , bgroup "lookup(absent)"+      [ env+        (let elems = genElems n+             m = L.fromList elems+             k = fst (random (mkStdGen (-1)))+         in pure (m, k))+        (\ ~(m, k) -> bench (show n) (whnf (L.lookup k) m))+      | n <- [100, 1000, 2000]+      ]+  , bgroup "Vector.lookup(present)"+      [ env+        (let elems = genElems n+             v = V.fromListN n elems+             k = fst (elems !! (length elems `div` 2))+         in pure (v, k))+        (\ ~(v, k) -> bench (show n) (whnf (V.find ((== k) . fst)) v))+      | n <- [100, 1000, 2000]+      ]+  , bgroup "Vector.lookup(absent)"+      [ env+        (let elems = genElems n+             v = V.fromListN n elems+             k = fst (random (mkStdGen (-1)))+         in pure (v, k))+        (\ ~(v, k) -> bench (show n) (whnf (V.find ((== k) . fst)) v))+      | n <- [100, 1000, 2000]+      ]+  ]

lattices/Algebra/PartialOrd.hs view

@@ -1,154 +1,154 @@-{-# LANGUAGE Safe #-}
-----------------------------------------------------------------------------
--- |
--- Module      :  Algebra.PartialOrd
--- Copyright   :  (C) 2010-2015 Maximilian Bolingbroke
--- License     :  BSD-3-Clause (see the file LICENSE)
---
--- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>
---
-----------------------------------------------------------------------------
-module Algebra.PartialOrd (
-    -- * Partial orderings
-    PartialOrd(..),
-    partialOrdEq,
-
-    -- * Fixed points of chains in partial orders
-    lfpFrom, unsafeLfpFrom,
-    gfpFrom, unsafeGfpFrom
-  ) where
-
-import qualified Data.IntMap as IM
-import qualified Data.IntSet as IS
-import qualified Data.Map    as M
-import qualified Data.Set    as S
-import           Data.Void   (Void)
-
--- | A partial ordering on sets
--- (<http://en.wikipedia.org/wiki/Partially_ordered_set>) is a set equipped
--- with a binary relation, `leq`, that obeys the following laws
---
--- @
--- Reflexive:     a ``leq`` a
--- Antisymmetric: a ``leq`` b && b ``leq`` a ==> a == b
--- Transitive:    a ``leq`` b && b ``leq`` c ==> a ``leq`` c
--- @
---
--- Two elements of the set are said to be `comparable` when they are are
--- ordered with respect to the `leq` relation. So
---
--- @
--- `comparable` a b ==> a ``leq`` b || b ``leq`` a
--- @
---
--- If `comparable` always returns true then the relation `leq` defines a
--- total ordering (and an `Ord` instance may be defined). Any `Ord` instance is
--- trivially an instance of `PartialOrd`. 'Algebra.Lattice.Ordered' provides a
--- convenient wrapper to satisfy 'PartialOrd' given 'Ord'.
---
--- As an example consider the partial ordering on sets induced by set
--- inclusion.  Then for sets `a` and `b`,
---
--- @
--- a ``leq`` b
--- @
---
--- is true when `a` is a subset of `b`.  Two sets are `comparable` if one is a
--- subset of the other. Concretely
---
--- @
--- a = {1, 2, 3}
--- b = {1, 3, 4}
--- c = {1, 2}
---
--- a ``leq`` a = `True`
--- a ``leq`` b = `False`
--- a ``leq`` c = `False`
--- b ``leq`` a = `False`
--- b ``leq`` b = `True`
--- b ``leq`` c = `False`
--- c ``leq`` a = `True`
--- c ``leq`` b = `False`
--- c ``leq`` c = `True`
---
--- `comparable` a b = `False`
--- `comparable` a c = `True`
--- `comparable` b c = `False`
--- @
-class Eq a => PartialOrd a where
-    -- | The relation that induces the partial ordering
-    leq :: a -> a -> Bool
-
-    -- | Whether two elements are ordered with respect to the relation. A
-    -- default implementation is given by
-    --
-    -- > comparable x y = leq x y || leq y x
-    comparable :: a -> a -> Bool
-    comparable x y = leq x y || leq y x
-
--- | The equality relation induced by the partial-order structure. It must obey
--- the laws
--- @
--- Reflexive:  a == a
--- Transitive: a == b && b == c ==> a == c
--- @
-partialOrdEq :: PartialOrd a => a -> a -> Bool
-partialOrdEq x y = leq x y && leq y x
-
-instance PartialOrd () where
-    leq _ _ = True
-
-instance PartialOrd Void where
-    leq _ _ = True
-
-instance Ord a => PartialOrd (S.Set a) where
-    leq = S.isSubsetOf
-
-instance PartialOrd IS.IntSet where
-    leq = IS.isSubsetOf
-
-instance (Ord k, PartialOrd v) => PartialOrd (M.Map k v) where
-    leq = M.isSubmapOfBy leq
-
-instance PartialOrd v => PartialOrd (IM.IntMap v) where
-    leq = IM.isSubmapOfBy leq
-
-instance (PartialOrd a, PartialOrd b) => PartialOrd (a, b) where
-    -- NB: *not* a lexical ordering. This is because for some component partial orders, lexical
-    -- ordering is incompatible with the transitivity axiom we require for the derived partial order
-    (x1, y1) `leq` (x2, y2) = x1 `leq` x2 && y1 `leq` y2
-
--- | Least point of a partially ordered monotone function. Checks that the function is monotone.
-lfpFrom :: PartialOrd a => a -> (a -> a) -> a
-lfpFrom = lfpFrom' leq
-
--- | Least point of a partially ordered monotone function. Does not checks that the function is monotone.
-unsafeLfpFrom :: Eq a => a -> (a -> a) -> a
-unsafeLfpFrom = lfpFrom' (\_ _ -> True)
-
-{-# INLINE lfpFrom' #-}
-lfpFrom' :: Eq a => (a -> a -> Bool) -> a -> (a -> a) -> a
-lfpFrom' check init_x f = go init_x
-  where go x | x' == x      = x
-             | x `check` x' = go x'
-             | otherwise    = error "lfpFrom: non-monotone function"
-          where x' = f x
-
-
--- | Greatest fixed point of a partially ordered antinone function. Checks that the function is antinone.
-{-# INLINE gfpFrom #-}
-gfpFrom :: PartialOrd a => a -> (a -> a) -> a
-gfpFrom = gfpFrom' leq
-
--- | Greatest fixed point of a partially ordered antinone function. Does not check that the function is antinone.
-{-# INLINE unsafeGfpFrom #-}
-unsafeGfpFrom :: Eq a => a -> (a -> a) -> a
-unsafeGfpFrom = gfpFrom' (\_ _ -> True)
-
-{-# INLINE gfpFrom' #-}
-gfpFrom' :: Eq a => (a -> a -> Bool) -> a -> (a -> a) -> a
-gfpFrom' check init_x f = go init_x
-  where go x | x' == x      = x
-             | x' `check` x = go x'
-             | otherwise    = error "gfpFrom: non-antinone function"
-          where x' = f x
+{-# LANGUAGE Safe #-}+----------------------------------------------------------------------------+-- |+-- Module      :  Algebra.PartialOrd+-- Copyright   :  (C) 2010-2015 Maximilian Bolingbroke+-- License     :  BSD-3-Clause (see the file LICENSE)+--+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+----------------------------------------------------------------------------+module Algebra.PartialOrd (+    -- * Partial orderings+    PartialOrd(..),+    partialOrdEq,++    -- * Fixed points of chains in partial orders+    lfpFrom, unsafeLfpFrom,+    gfpFrom, unsafeGfpFrom+  ) where++import qualified Data.IntMap as IM+import qualified Data.IntSet as IS+import qualified Data.Map    as M+import qualified Data.Set    as S+import           Data.Void   (Void)++-- | A partial ordering on sets+-- (<http://en.wikipedia.org/wiki/Partially_ordered_set>) is a set equipped+-- with a binary relation, `leq`, that obeys the following laws+--+-- @+-- Reflexive:     a ``leq`` a+-- Antisymmetric: a ``leq`` b && b ``leq`` a ==> a == b+-- Transitive:    a ``leq`` b && b ``leq`` c ==> a ``leq`` c+-- @+--+-- Two elements of the set are said to be `comparable` when they are are+-- ordered with respect to the `leq` relation. So+--+-- @+-- `comparable` a b ==> a ``leq`` b || b ``leq`` a+-- @+--+-- If `comparable` always returns true then the relation `leq` defines a+-- total ordering (and an `Ord` instance may be defined). Any `Ord` instance is+-- trivially an instance of `PartialOrd`. 'Algebra.Lattice.Ordered' provides a+-- convenient wrapper to satisfy 'PartialOrd' given 'Ord'.+--+-- As an example consider the partial ordering on sets induced by set+-- inclusion.  Then for sets `a` and `b`,+--+-- @+-- a ``leq`` b+-- @+--+-- is true when `a` is a subset of `b`.  Two sets are `comparable` if one is a+-- subset of the other. Concretely+--+-- @+-- a = {1, 2, 3}+-- b = {1, 3, 4}+-- c = {1, 2}+--+-- a ``leq`` a = `True`+-- a ``leq`` b = `False`+-- a ``leq`` c = `False`+-- b ``leq`` a = `False`+-- b ``leq`` b = `True`+-- b ``leq`` c = `False`+-- c ``leq`` a = `True`+-- c ``leq`` b = `False`+-- c ``leq`` c = `True`+--+-- `comparable` a b = `False`+-- `comparable` a c = `True`+-- `comparable` b c = `False`+-- @+class Eq a => PartialOrd a where+    -- | The relation that induces the partial ordering+    leq :: a -> a -> Bool++    -- | Whether two elements are ordered with respect to the relation. A+    -- default implementation is given by+    --+    -- > comparable x y = leq x y || leq y x+    comparable :: a -> a -> Bool+    comparable x y = leq x y || leq y x++-- | The equality relation induced by the partial-order structure. It must obey+-- the laws+-- @+-- Reflexive:  a == a+-- Transitive: a == b && b == c ==> a == c+-- @+partialOrdEq :: PartialOrd a => a -> a -> Bool+partialOrdEq x y = leq x y && leq y x++instance PartialOrd () where+    leq _ _ = True++instance PartialOrd Void where+    leq _ _ = True++instance Ord a => PartialOrd (S.Set a) where+    leq = S.isSubsetOf++instance PartialOrd IS.IntSet where+    leq = IS.isSubsetOf++instance (Ord k, PartialOrd v) => PartialOrd (M.Map k v) where+    leq = M.isSubmapOfBy leq++instance PartialOrd v => PartialOrd (IM.IntMap v) where+    leq = IM.isSubmapOfBy leq++instance (PartialOrd a, PartialOrd b) => PartialOrd (a, b) where+    -- NB: *not* a lexical ordering. This is because for some component partial orders, lexical+    -- ordering is incompatible with the transitivity axiom we require for the derived partial order+    (x1, y1) `leq` (x2, y2) = x1 `leq` x2 && y1 `leq` y2++-- | Least point of a partially ordered monotone function. Checks that the function is monotone.+lfpFrom :: PartialOrd a => a -> (a -> a) -> a+lfpFrom = lfpFrom' leq++-- | Least point of a partially ordered monotone function. Does not checks that the function is monotone.+unsafeLfpFrom :: Eq a => a -> (a -> a) -> a+unsafeLfpFrom = lfpFrom' (\_ _ -> True)++{-# INLINE lfpFrom' #-}+lfpFrom' :: Eq a => (a -> a -> Bool) -> a -> (a -> a) -> a+lfpFrom' check init_x f = go init_x+  where go x | x' == x      = x+             | x `check` x' = go x'+             | otherwise    = error "lfpFrom: non-monotone function"+          where x' = f x+++-- | Greatest fixed point of a partially ordered antinone function. Checks that the function is antinone.+{-# INLINE gfpFrom #-}+gfpFrom :: PartialOrd a => a -> (a -> a) -> a+gfpFrom = gfpFrom' leq++-- | Greatest fixed point of a partially ordered antinone function. Does not check that the function is antinone.+{-# INLINE unsafeGfpFrom #-}+unsafeGfpFrom :: Eq a => a -> (a -> a) -> a+unsafeGfpFrom = gfpFrom' (\_ _ -> True)++{-# INLINE gfpFrom' #-}+gfpFrom' :: Eq a => (a -> a -> Bool) -> a -> (a -> a) -> a+gfpFrom' check init_x f = go init_x+  where go x | x' == x      = x+             | x' `check` x = go x'+             | otherwise    = error "gfpFrom: non-antinone function"+          where x' = f x

pomaps.cabal view

@@ -1,5 +1,5 @@ name:           pomaps-version:        0.0.0.4+version:        0.0.1.0 synopsis:       Maps and sets of partial orders category:       Data Structures homepage:       https://github.com/sgraf812/pomaps#readme@@ -13,16 +13,15 @@ extra-source-files:     CHANGELOG.md     LICENSE.md-    README.md     stack.yaml  description:   Maps (and sets) indexed by keys satisfying <https://hackage.haskell.org/package/lattices/docs/Algebra-PartialOrd.html#t:PartialOrd PartialOrd>.   .   The goal is to provide asymptotically better data structures than simple association lists or lookup tables.-  Asymptotics depend on the partial order used as keys, its /width/ \(w\) specifically (the size of the biggest anti-chain).+  Asymptotics depend on the partial order used as keys, its width /w/ specifically (the size of the biggest anti-chain).   .-  For partial orders with great width, this package won't provide any benefit over using association lists, so benchmark for your use-case!+  For partial orders of great width, this package won't provide any benefit over using association lists, so benchmark for your use-case!  source-repository head   type: git@@ -42,10 +41,10 @@     , ghc-prim >= 0.4 && < 0.6     , deepseq >= 1.1 && < 1.5     -- We depend on the internal modules of containers, -    -- so we have to track development real close.+    -- so we have to track development really close.     -- Data.Map.Internal is only available since 0.5.9,     -- of which 0.5.9.2 is the first safe version-    , containers >= 0.5.9.2 && <= 0.5.11.0+    , containers >= 0.5.9.2 && <= 0.6.0.1   if !flag(no-lattices)     build-depends:      -- We need PartialOrd instances for ()

src/Data/POMap/Internal.hs view

@@ -103,8 +103,7 @@ instance (PartialOrd k, Read k, Read e) => Read (POMap k e) where
   readPrec = parens $ prec 10 $ do
     Ident "fromList" <- lexP
-    xs <- readPrec
-    return (fromListImpl (proxy# :: Proxy# 'Lazy) xs)
+    fromListImpl (proxy# :: Proxy# 'Lazy) <$> readPrec
 
   readListPrec = readListPrecDefault
 
@@ -1113,6 +1112,47 @@   . unzip
   . fmap (Map.partitionWithKey p)
   $ d
+
+-- | \(\mathcal{O}(log n)\). Take while a predicate on the keys holds.
+-- The user is responsible for ensuring that for all keys @j@ and @k@ in the map,
+-- @j \< k ==\> p j \>= p k@. See note at 'spanAntitone'.
+--
+-- @
+-- takeWhileAntitone p = 'filterWithKey' (\k _ -> p k)
+-- @
+--
+-- @since 0.0.1.0
+takeWhileAntitone :: (k -> Bool) -> POMap k v -> POMap k v
+takeWhileAntitone p = mkPOMap . fmap (Map.Strict.takeWhileAntitone p) . chainDecomposition
+
+-- | \(\mathcal{O}(log n)\). Drop while a predicate on the keys holds.
+-- The user is responsible for ensuring that for all keys @j@ and @k@ in the map,
+-- @j \< k ==\> p j \>= p k@. See note at 'spanAntitone'.
+--
+-- @
+-- dropWhileAntitone p = 'filterWithKey' (\k -> not (p k))
+-- @
+--
+-- @since 0.0.1.0
+dropWhileAntitone :: (k -> Bool) -> POMap k v -> POMap k v
+dropWhileAntitone p = mkPOMap . fmap (Map.Strict.dropWhileAntitone p) . chainDecomposition
+
+-- | \(\mathcal{O}(log n)\). Divide a map at the point where a predicate on the keys stops holding.
+-- The user is responsible for ensuring that for all keys @j@ and @k@ in the map,
+-- @j \< k ==\> p j \>= p k@.
+--
+-- @
+-- spanAntitone p xs = 'partitionWithKey' (\k _ -> p k) xs
+-- @
+--
+-- Note: if @p@ is not actually antitone, then @spanAntitone@ will split the map
+-- at some /unspecified/ point where the predicate switches from holding to not
+-- holding (where the predicate is seen to hold before the first key and to fail
+-- after the last key).
+--
+-- @since 0.0.1.0
+spanAntitone :: (k -> Bool) -> POMap k v -> (POMap k v, POMap k v)
+spanAntitone p = (mkPOMap *** mkPOMap) . unzip . fmap (Map.Strict.spanAntitone p) . chainDecomposition
 
 mapMaybe :: SingIAreWeStrict s => Proxy# s -> (a -> Maybe b) -> POMap k a -> POMap k b
 mapMaybe s f = mapMaybeWithKey s (const f)

src/Data/POMap/Lazy.hs view

@@ -171,6 +171,10 @@   , Impl.partition
   , Impl.partitionWithKey
 
+  , Impl.takeWhileAntitone
+  , Impl.dropWhileAntitone
+  , Impl.spanAntitone
+
   , mapMaybe
   , mapMaybeWithKey
   , mapEither

src/Data/POMap/Strict.hs view

@@ -175,6 +175,10 @@   , Impl.partition
   , Impl.partitionWithKey
 
+  , Impl.takeWhileAntitone
+  , Impl.dropWhileAntitone
+  , Impl.spanAntitone
+
   , mapMaybe
   , mapMaybeWithKey
   , mapEither

src/Data/POSet.hs view

@@ -1,117 +1,117 @@--- |
--- Module      :  Data.POSet
--- Copyright   :  (c) Sebastian Graf 2017
--- License     :  MIT
--- Maintainer  :  sgraf1337@gmail.com
--- Portability :  portable
---
--- A reasonably efficient implementation of partially ordered sets.
---
--- These modules are intended to be imported qualified, to avoid name
--- clashes with Prelude functions, e.g.
---
--- > import qualified Data.POSet as POSet
---
--- The implementation of 'POSet' is based on a decomposition of
--- chains (totally ordered submaps), inspired by
--- [\"Sorting and Selection in Posets\"](https://arxiv.org/abs/0707.1532).
---
--- Operation comments contain the operation time complexity in
--- [Big-O notation](http://en.wikipedia.org/wiki/Big_O_notation) and
--- commonly refer to two characteristics of the poset from which keys are drawn:
--- The number of elements in the set \(n\) and the /width/ \(w\) of the poset,
--- referring to the size of the biggest anti-chain (set of incomparable elements).
---
--- Generally speaking, lookup and mutation operations incur an additional
--- factor of \(\mathcal{O}(w)\) compared to their counter-parts in "Data.Set".
---
--- Note that for practical applications, the width of the poset should be
--- in the order of \(w\in \mathcal{O}(\frac{n}{\log n})\), otherwise a simple lookup list
--- is asymptotically superior.
--- Even if that holds, the constants might be too big to be useful for any \(n\) that can
--- can happen in practice.
---
--- The following examples assume the following definitions for a set on the divisibility
--- relation on `Int`egers:
---
--- @
--- {-\# LANGUAGE GeneralizedNewtypeDeriving \#-}
---
--- import           Algebra.PartialOrd
--- import           Data.POSet (POSet)
--- import qualified Data.POSet as POSet
---
--- newtype Divisibility
---   = Div Int
---   deriving (Eq, Read, Show, Num)
---
--- default (Divisibility)
---
--- instance 'PartialOrd' Divisibility where
---   Div a \`leq\` Div b = b \`mod\` a == 0
---
--- type DivSet = POSet Divisibility
---
--- -- We want integer literals to be interpreted as 'Divisibility's
--- -- and default 'empty's to DivSet.
--- default (Divisibility, DivSet)
--- @
---
--- 'Divisility' is actually an example for a 'PartialOrd' that should not be used as keys of 'POSet'.
--- Its width is \(w=\frac{n}{2}\in\Omega(n)\)!
-
-module Data.POSet
-  (
-  -- * Set type
-    Impl.POSet
-  -- * Query
-  , Foldable.null
-  , Impl.size
-  , Impl.member
-  , Impl.notMember
-  , Impl.lookupLT
-  , Impl.lookupGT
-  , Impl.lookupLE
-  , Impl.lookupGE
-  , Impl.isSubsetOf
-  , Impl.isProperSubsetOf
-
-  -- * Construction
-  , Impl.empty
-  , Impl.singleton
-  , Impl.insert
-  , Impl.delete
-
-  -- * Combine
-  , Impl.union
-  , Impl.unions
-  , Impl.difference
-  , Impl.intersection
-
-  -- * Filter
-  , Impl.filter
-  , Impl.partition
-
-  -- * Map
-  , Impl.map
-  , Impl.mapMonotonic
-
-  -- * Folds
-  , Foldable.foldr
-  , Foldable.foldl
-  -- ** Strict folds
-  , Impl.foldr'
-  , Impl.foldl'
-
-  -- * Min\/Max
-  , Impl.lookupMin
-  , Impl.lookupMax
-
-  -- * Conversion
-  , Impl.elems
-  , Impl.toList
-  , Impl.fromList
-  ) where
-
-import qualified Data.Foldable       as Foldable
-import qualified Data.POSet.Internal as Impl
+-- |+-- Module      :  Data.POSet+-- Copyright   :  (c) Sebastian Graf 2017+-- License     :  MIT+-- Maintainer  :  sgraf1337@gmail.com+-- Portability :  portable+--+-- A reasonably efficient implementation of partially ordered sets.+--+-- These modules are intended to be imported qualified, to avoid name+-- clashes with Prelude functions, e.g.+--+-- > import qualified Data.POSet as POSet+--+-- The implementation of 'POSet' is based on a decomposition of+-- chains (totally ordered submaps), inspired by+-- [\"Sorting and Selection in Posets\"](https://arxiv.org/abs/0707.1532).+--+-- Operation comments contain the operation time complexity in+-- [Big-O notation](http://en.wikipedia.org/wiki/Big_O_notation) and+-- commonly refer to two characteristics of the poset from which keys are drawn:+-- The number of elements in the set \(n\) and the /width/ \(w\) of the poset,+-- referring to the size of the biggest anti-chain (set of incomparable elements).+--+-- Generally speaking, lookup and mutation operations incur an additional+-- factor of \(\mathcal{O}(w)\) compared to their counter-parts in "Data.Set".+--+-- Note that for practical applications, the width of the poset should be+-- in the order of \(w\in \mathcal{O}(\frac{n}{\log n})\), otherwise a simple lookup list+-- is asymptotically superior.+-- Even if that holds, the constants might be too big to be useful for any \(n\) that can+-- can happen in practice.+--+-- The following examples assume the following definitions for a set on the divisibility+-- relation on `Int`egers:+--+-- @+-- {-\# LANGUAGE GeneralizedNewtypeDeriving \#-}+--+-- import           Algebra.PartialOrd+-- import           Data.POSet (POSet)+-- import qualified Data.POSet as POSet+--+-- newtype Divisibility+--   = Div Int+--   deriving (Eq, Read, Show, Num)+--+-- default (Divisibility)+--+-- instance 'PartialOrd' Divisibility where+--   Div a \`leq\` Div b = b \`mod\` a == 0+--+-- type DivSet = POSet Divisibility+--+-- -- We want integer literals to be interpreted as 'Divisibility's+-- -- and default 'empty's to DivSet.+-- default (Divisibility, DivSet)+-- @+--+-- 'Divisility' is actually an example for a 'PartialOrd' that should not be used as keys of 'POSet'.+-- Its width is \(w=\frac{n}{2}\in\Omega(n)\)!++module Data.POSet+  (+  -- * Set type+    Impl.POSet+  -- * Query+  , Foldable.null+  , Impl.size+  , Impl.member+  , Impl.notMember+  , Impl.lookupLT+  , Impl.lookupGT+  , Impl.lookupLE+  , Impl.lookupGE+  , Impl.isSubsetOf+  , Impl.isProperSubsetOf++  -- * Construction+  , Impl.empty+  , Impl.singleton+  , Impl.insert+  , Impl.delete++  -- * Combine+  , Impl.union+  , Impl.unions+  , Impl.difference+  , Impl.intersection++  -- * Filter+  , Impl.filter+  , Impl.partition++  -- * Map+  , Impl.map+  , Impl.mapMonotonic++  -- * Folds+  , Foldable.foldr+  , Foldable.foldl+  -- ** Strict folds+  , Impl.foldr'+  , Impl.foldl'++  -- * Min\/Max+  , Impl.lookupMin+  , Impl.lookupMax++  -- * Conversion+  , Impl.elems+  , Impl.toList+  , Impl.fromList+  ) where++import qualified Data.Foldable       as Foldable+import qualified Data.POSet.Internal as Impl

src/Data/POSet/Internal.hs view

@@ -1,356 +1,397 @@-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies     #-}
-
--- | This module doesn't respect the PVP!
--- Breaking changes may happen at any minor version (>= *.*.m.*)
-
-module Data.POSet.Internal where
-
-import           Algebra.PartialOrd
-import           Control.DeepSeq    (NFData (rnf))
-import qualified Data.List          as List
-import           Data.POMap.Lazy    (POMap)
-import qualified Data.POMap.Lazy    as POMap
-import           GHC.Exts           (coerce)
-import qualified GHC.Exts
-import           Text.Read          (Lexeme (Ident), Read (..), lexP, parens,
-                                     prec, readListPrecDefault)
-
--- $setup
--- This is some setup code for @doctest@.
--- >>> :set -XGeneralizedNewtypeDeriving
--- >>> import           Algebra.PartialOrd
--- >>> import           Data.POSet
--- >>> :{
---   newtype Divisibility
---     = Div Int
---     deriving (Eq, Num)
---   instance Show Divisibility where
---     show (Div a) = show a
---   instance PartialOrd Divisibility where
---     Div a `leq` Div b = b `mod` a == 0
---   type DivSet = POSet Divisibility
---   default (Divisibility, DivSet)
--- :}
-
--- | A set of partially ordered values @k@.
-newtype POSet k
-  = POSet (POMap k ())
-
---
--- * Instances
---
-
-instance PartialOrd k => Eq (POSet k) where
-  POSet a == POSet b = a == b
-
-instance PartialOrd k => PartialOrd (POSet k) where
-  POSet a `leq` POSet b = a `leq` b
-
-instance Show a => Show (POSet a) where
-  showsPrec p xs = showParen (p > 10) $
-    showString "fromList " . shows (toList xs)
-
-instance (Read a, PartialOrd a) => Read (POSet a) where
-  readPrec = parens $ prec 10 $ do
-    Ident "fromList" <- lexP
-    xs <- readPrec
-    return (fromList xs)
-
-  readListPrec = readListPrecDefault
-
-instance NFData a => NFData (POSet a) where
-  rnf (POSet m) = rnf m
-
-instance Foldable POSet where
-  foldr f = coerce (POMap.foldrWithKey @_ @() (\k _ acc -> f k acc))
-  {-# INLINE foldr #-}
-  foldl f = coerce (POMap.foldlWithKey @_ @_ @() (\k acc _ -> f k acc))
-  {-# INLINE foldl #-}
-  null m = size m == 0
-  {-# INLINE null #-}
-  length = size
-  {-# INLINE length #-}
-
-instance PartialOrd k => GHC.Exts.IsList (POSet k) where
-  type Item (POSet k) = k
-  fromList = fromList
-  toList = toList
-
---
--- * Query
---
-
--- | \(\mathcal{O}(1)\). The number of elements in this set.
-size :: POSet k -> Int
-size = coerce (POMap.size @_ @())
-{-# INLINE size #-}
-
--- | \(\mathcal{O}(w)\).
--- The width \(w\) of the chain decomposition in the internal
--- data structure.
--- This is always at least as big as the size of the biggest possible
--- anti-chain.
-width :: POSet k -> Int
-width = coerce (POMap.width @_ @())
-{-# INLINE width #-}
-
--- | \(\mathcal{O}(w\log n)\).
--- Is the key a member of the map? See also 'notMember'.
-member :: PartialOrd k => k -> POSet k -> Bool
-member = coerce (POMap.member @_ @())
-{-# INLINE member #-}
-
--- | \(\mathcal{O}(w\log n)\).
--- Is the key not a member of the map? See also 'member'.
-notMember :: PartialOrd k => k -> POSet k -> Bool
-notMember = coerce (POMap.notMember @_ @())
-{-# INLINE notMember #-}
-
--- | \(\mathcal{O}(w\log n)\).
--- Find the largest set of keys smaller than the given one and
--- return the corresponding list of (key, value) pairs.
---
--- Note that the following examples assume the @Divisibility@
--- partial order defined at the top.
---
--- >>> lookupLT 3 (fromList [3, 5])
--- []
--- >>> lookupLT 6 (fromList [3, 5])
--- [3]
-lookupLT :: PartialOrd k => k -> POSet k -> [k]
-lookupLT k = List.map @(_,()) fst . coerce (POMap.lookupLT @_ @() k)
-{-# INLINE lookupLT #-}
-
--- | \(\mathcal{O}(w\log n)\).
--- Find the largest key smaller or equal to the given one and return
--- the corresponding list of (key, value) pairs.
---
--- Note that the following examples assume the @Divisibility@
--- partial order defined at the top.
---
--- >>> lookupLE 2  (fromList [3, 5])
--- []
--- >>> lookupLE 3  (fromList [3, 5])
--- [3]
--- >>> lookupLE 10 (fromList [3, 5])
--- [5]
-lookupLE :: PartialOrd k => k -> POSet k -> [k]
-lookupLE k = List.map @(_,()) fst . coerce (POMap.lookupLE @_ @() k)
-{-# INLINE lookupLE #-}
-
--- | \(\mathcal{O}(w\log n)\).
--- Find the smallest key greater or equal to the given one and return
--- the corresponding list of (key, value) pairs.
---
--- Note that the following examples assume the @Divisibility@
--- partial order defined at the top.
---
--- >>> lookupGE 3 (fromList [3, 5])
--- [3]
--- >>> lookupGE 5 (fromList [3, 10])
--- [10]
--- >>> lookupGE 6 (fromList [3, 5])
--- []
-lookupGE :: PartialOrd k => k -> POSet k -> [k]
-lookupGE k = List.map @(_,()) fst . coerce (POMap.lookupGE @_ @() k)
-{-# INLINE lookupGE #-}
-
--- | \(\mathcal{O}(w\log n)\).
--- Find the smallest key greater than the given one and return the
--- corresponding list of (key, value) pairs.
---
--- Note that the following examples assume the @Divisibility@
--- partial order defined at the top.
---
--- >>> lookupGT 3 (fromList [6, 5])
--- [6]
--- >>> lookupGT 5 (fromList [3, 5])
--- []
-lookupGT :: PartialOrd k => k -> POSet k -> [k]
-lookupGT k = List.map @(_,()) fst . coerce (POMap.lookupGT @_ @() k)
-{-# INLINE lookupGT #-}
-
--- | \(\mathcal{O}(n_2 w_1 n_1 \log n_1)\).
--- @(s1 `isSubsetOf` s2)@ tells whether @s1@ is a subset of @s2@.
-isSubsetOf :: PartialOrd k => POSet k -> POSet k -> Bool
-isSubsetOf = coerce (POMap.isSubmapOf @_ @())
-{-# INLINE isSubsetOf #-}
-
--- | \(\mathcal{O}(n_2 w_1 n_1 \log n_1)\).
--- Is this a proper subset? (ie. a subset but not equal).
-isProperSubsetOf :: PartialOrd k => POSet k -> POSet k -> Bool
-isProperSubsetOf = coerce (POMap.isProperSubmapOf @_ @())
-{-# INLINE isProperSubsetOf #-}
-
---
--- * Construction
---
-
--- | \(\mathcal{O}(1)\). The empty set.
-empty :: POSet k
-empty = POSet POMap.empty
-{-# INLINE empty #-}
-
--- | \(\mathcal{O}(1)\). A set with a single element.
-singleton :: k -> POSet k
-singleton k = POSet (POMap.singleton k ())
-{-# INLINE singleton #-}
--- INLINE means we don't need to SPECIALIZE
-
--- | \(\mathcal{O}(w\log n)\).
--- If the key is already present in the map, the associated value is
--- replaced with the supplied value. 'insert' is equivalent to
--- @'insertWith' 'const'@.
-insert :: (PartialOrd k) => k -> POSet k -> POSet k
-insert k = coerce (POMap.insert k ())
-{-# INLINE insert #-}
-
--- | \(\mathcal{O}(w\log n)\).
--- Delete an element from a set.
-delete :: (PartialOrd k) => k -> POSet k -> POSet k
-delete = coerce (POMap.delete @_ @())
-{-# INLINE delete #-}
-
---
--- * Combine
---
-
--- ** Union
-
--- | \(\mathcal{O}(wn\log n)\), where \(n=\max(n_1,n_2)\) and \(w=\max(w_1,w_2)\).
--- The union of two sets, preferring the first set when
--- equal elements are encountered.
-union :: PartialOrd k => POSet k -> POSet k -> POSet k
-union = coerce (POMap.union @_ @())
-{-# INLINE union #-}
-
--- | \(\mathcal{O}(wn\log n)\), where \(n=\max_i n_i\) and \(w=\max_i w_i\).
--- The union of a list of sets: (@'unions' == 'foldl' 'union' 'empty'@).
-unions :: PartialOrd k => [POSet k] -> POSet k
-unions = coerce (POMap.unions @_ @())
-{-# INLINE unions #-}
-
--- ** Difference
-
--- | \(\mathcal{O}(wn\log n)\), where \(n=\max(n_1,n_2)\) and \(w=\max(w_1,w_2)\).
--- Difference of two sets.
-difference :: PartialOrd k => POSet k -> POSet k -> POSet k
-difference = coerce (POMap.difference @_ @() @())
-{-# INLINE difference #-}
-
--- ** Intersection
-
--- | \(\mathcal{O}(wn\log n)\), where \(n=\max(n_1,n_2)\) and \(w=\max(w_1,w_2)\).
--- The intersection of two sets.
--- Elements of the result come from the first set, so for example
---
--- >>> data AB = A | B deriving Show
--- >>> instance Eq AB where _ == _ = True
--- >>> instance PartialOrd AB where _ `leq` _ = True
--- >>> singleton A `intersection` singleton B
--- fromList [A]
--- >>> singleton B `intersection` singleton A
--- fromList [B]
-intersection :: PartialOrd k => POSet k -> POSet k -> POSet k
-intersection = coerce (POMap.intersection @_ @() @())
-{-# INLINE intersection #-}
-
---
--- * Filter
---
-
--- | \(\mathcal{O}(n)\).
--- Filter all elements that satisfy the predicate.
-filter :: (k -> Bool) -> POSet k -> POSet k
-filter f = coerce (POMap.filterWithKey @_ @() (\k _ -> f k))
-{-# INLINE filter #-}
-
--- | \(\mathcal{O}(n)\).
--- 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.
-partition :: (k -> Bool) -> POSet k -> (POSet k, POSet k)
-partition f = coerce (POMap.partitionWithKey @_ @() (\k _ -> f k))
-{-# INLINE partition #-}
-
---
--- * Map
---
-
--- | \(\mathcal{O}(wn\log n)\).
--- @'map' f s@ is the set obtained by applying @f@ to each element of @s@.
---
--- It's worth noting that the size of the result may be smaller if,
--- for some @(x,y)@, @x \/= y && f x == f y@
-map :: PartialOrd k2 => (k1 -> k2) -> POSet k1 -> POSet k2
-map = coerce (POMap.mapKeys @_ @_ @())
-{-# INLINE map #-}
-
--- | \(\mathcal{O}(n)\).
--- @'mapMonotonic' f s == 'map' f s@, but works only when @f@ is strictly increasing.
--- /The precondition is not checked./
--- Semi-formally, for every chain @ls@ in @s@ we have:
---
--- > and [x < y ==> f x < f y | x <- ls, y <- ls]
--- >                     ==> mapMonotonic f s == map f s
-mapMonotonic :: (k1 -> k2) -> POSet k1 -> POSet k2
-mapMonotonic = coerce (POMap.mapKeysMonotonic @_ @_ @())
-{-# INLINE mapMonotonic #-}
-
---
--- * Folds
---
-
--- | \(\mathcal{O}(n)\).
--- A strict version of 'foldr'. Each application of the operator is
--- evaluated before using the result in the next application. This
--- function is strict in the starting value.
-foldr' :: (a -> b -> b) -> b -> POSet a -> b
-foldr' f = coerce (POMap.foldrWithKey' @_ @()  (\k _ acc -> f k acc))
-{-# INLINE foldr' #-}
-
--- | \(\mathcal{O}(n)\).
--- A strict version of 'foldl'. Each application of the operator is
--- evaluated before using the result in the next application. This
--- function is strict in the starting value.
-foldl' :: (b -> a -> b) -> b -> POSet a -> b
-foldl' f = coerce (POMap.foldlWithKey' @_ @_ @()  (\k acc _ -> f k acc))
-{-# INLINE foldl' #-}
-
---
--- * Min/Max
---
-
--- | \(\mathcal{O}(w\log n)\).
--- The minimal keys of the set.
-lookupMin :: PartialOrd k => POSet k -> [k]
-lookupMin = List.map @(_,()) fst . coerce (POMap.lookupMin @_ @())
-{-# INLINE lookupMin #-}
-
--- | \(\mathcal{O}(w\log n)\).
--- The maximal keys of the set.
-lookupMax :: PartialOrd k => POSet k -> [k]
-lookupMax = List.map @(_,()) fst . coerce (POMap.lookupMax @_ @())
-{-# INLINE lookupMax #-}
-
---
--- * Conversion
---
-
--- | \(\mathcal{O}(n)\).
--- The elements of a set in unspecified order.
-elems :: POSet k -> [k]
-elems = coerce (POMap.keys @_ @())
-{-# INLINE elems #-}
-
--- | \(\mathcal{O}(n)\).
--- The elements of a set in unspecified order.
-toList :: POSet k -> [k]
-toList = coerce (POMap.keys @_ @())
-{-# INLINE toList #-}
-
--- | \(\mathcal{O}(wn\log n)\).
--- Build a set from a list of keys.
-fromList :: (PartialOrd k) => [k] -> POSet k
-fromList = coerce (POMap.fromList @_ @()) . List.map (\k -> (k, ()))
-{-# INLINE fromList #-}
+{-# LANGUAGE TupleSections    #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies     #-}++-- | This module doesn't respect the PVP!+-- Breaking changes may happen at any minor version (>= *.*.m.*)++module Data.POSet.Internal where++import           Algebra.PartialOrd+import           Control.DeepSeq    (NFData (rnf))+import qualified Data.List          as List+import           Data.POMap.Lazy    (POMap)+import qualified Data.POMap.Lazy    as POMap+import           GHC.Exts           (coerce)+import qualified GHC.Exts+import           Text.Read          (Lexeme (Ident), Read (..), lexP, parens,+                                     prec, readListPrecDefault)++-- $setup+-- This is some setup code for @doctest@.+-- >>> :set -XGeneralizedNewtypeDeriving+-- >>> import           Algebra.PartialOrd+-- >>> import           Data.POSet+-- >>> :{+--   newtype Divisibility+--     = Div Int+--     deriving (Eq, Num)+--   instance Show Divisibility where+--     show (Div a) = show a+--   instance PartialOrd Divisibility where+--     Div a `leq` Div b = b `mod` a == 0+--   type DivSet = POSet Divisibility+--   default (Divisibility, DivSet)+-- :}++-- | A set of partially ordered values @k@.+newtype POSet k+  = POSet (POMap k ())++--+-- * Instances+--++instance PartialOrd k => Eq (POSet k) where+  POSet a == POSet b = a == b++instance PartialOrd k => PartialOrd (POSet k) where+  POSet a `leq` POSet b = a `leq` b++instance Show a => Show (POSet a) where+  showsPrec p xs = showParen (p > 10) $+    showString "fromList " . shows (toList xs)++instance (Read a, PartialOrd a) => Read (POSet a) where+  readPrec = parens $ prec 10 $ do+    Ident "fromList" <- lexP+    fromList <$> readPrec++  readListPrec = readListPrecDefault++instance NFData a => NFData (POSet a) where+  rnf (POSet m) = rnf m++instance Foldable POSet where+  foldr f = coerce (POMap.foldrWithKey @_ @() (\k _ acc -> f k acc))+  {-# INLINE foldr #-}+  foldl f = coerce (POMap.foldlWithKey @_ @_ @() (\k acc _ -> f k acc))+  {-# INLINE foldl #-}+  null m = size m == 0+  {-# INLINE null #-}+  length = size+  {-# INLINE length #-}++instance PartialOrd k => GHC.Exts.IsList (POSet k) where+  type Item (POSet k) = k+  fromList = fromList+  toList = toList++--+-- * Query+--++-- | \(\mathcal{O}(1)\). The number of elements in this set.+size :: POSet k -> Int+size = coerce (POMap.size @_ @())+{-# INLINE size #-}++-- | \(\mathcal{O}(w)\).+-- The width \(w\) of the chain decomposition in the internal+-- data structure.+-- This is always at least as big as the size of the biggest possible+-- anti-chain.+width :: POSet k -> Int+width = coerce (POMap.width @_ @())+{-# INLINE width #-}++-- | \(\mathcal{O}(w\log n)\).+-- Is the key a member of the map? See also 'notMember'.+member :: PartialOrd k => k -> POSet k -> Bool+member = coerce (POMap.member @_ @())+{-# INLINE member #-}++-- | \(\mathcal{O}(w\log n)\).+-- Is the key not a member of the map? See also 'member'.+notMember :: PartialOrd k => k -> POSet k -> Bool+notMember = coerce (POMap.notMember @_ @())+{-# INLINE notMember #-}++-- | \(\mathcal{O}(w\log n)\).+-- Find the largest set of keys smaller than the given one and+-- return the corresponding list of (key, value) pairs.+--+-- Note that the following examples assume the @Divisibility@+-- partial order defined at the top.+--+-- >>> lookupLT 3 (fromList [3, 5])+-- []+-- >>> lookupLT 6 (fromList [3, 5])+-- [3]+lookupLT :: PartialOrd k => k -> POSet k -> [k]+lookupLT k = List.map @(_,()) fst . coerce (POMap.lookupLT @_ @() k)+{-# INLINE lookupLT #-}++-- | \(\mathcal{O}(w\log n)\).+-- Find the largest key smaller or equal to the given one and return+-- the corresponding list of (key, value) pairs.+--+-- Note that the following examples assume the @Divisibility@+-- partial order defined at the top.+--+-- >>> lookupLE 2  (fromList [3, 5])+-- []+-- >>> lookupLE 3  (fromList [3, 5])+-- [3]+-- >>> lookupLE 10 (fromList [3, 5])+-- [5]+lookupLE :: PartialOrd k => k -> POSet k -> [k]+lookupLE k = List.map @(_,()) fst . coerce (POMap.lookupLE @_ @() k)+{-# INLINE lookupLE #-}++-- | \(\mathcal{O}(w\log n)\).+-- Find the smallest key greater or equal to the given one and return+-- the corresponding list of (key, value) pairs.+--+-- Note that the following examples assume the @Divisibility@+-- partial order defined at the top.+--+-- >>> lookupGE 3 (fromList [3, 5])+-- [3]+-- >>> lookupGE 5 (fromList [3, 10])+-- [10]+-- >>> lookupGE 6 (fromList [3, 5])+-- []+lookupGE :: PartialOrd k => k -> POSet k -> [k]+lookupGE k = List.map @(_,()) fst . coerce (POMap.lookupGE @_ @() k)+{-# INLINE lookupGE #-}++-- | \(\mathcal{O}(w\log n)\).+-- Find the smallest key greater than the given one and return the+-- corresponding list of (key, value) pairs.+--+-- Note that the following examples assume the @Divisibility@+-- partial order defined at the top.+--+-- >>> lookupGT 3 (fromList [6, 5])+-- [6]+-- >>> lookupGT 5 (fromList [3, 5])+-- []+lookupGT :: PartialOrd k => k -> POSet k -> [k]+lookupGT k = List.map @(_,()) fst . coerce (POMap.lookupGT @_ @() k)+{-# INLINE lookupGT #-}++-- | \(\mathcal{O}(n_2 w_1 n_1 \log n_1)\).+-- @(s1 `isSubsetOf` s2)@ tells whether @s1@ is a subset of @s2@.+isSubsetOf :: PartialOrd k => POSet k -> POSet k -> Bool+isSubsetOf = coerce (POMap.isSubmapOf @_ @())+{-# INLINE isSubsetOf #-}++-- | \(\mathcal{O}(n_2 w_1 n_1 \log n_1)\).+-- Is this a proper subset? (ie. a subset but not equal).+isProperSubsetOf :: PartialOrd k => POSet k -> POSet k -> Bool+isProperSubsetOf = coerce (POMap.isProperSubmapOf @_ @())+{-# INLINE isProperSubsetOf #-}++--+-- * Construction+--++-- | \(\mathcal{O}(1)\). The empty set.+empty :: POSet k+empty = POSet POMap.empty+{-# INLINE empty #-}++-- | \(\mathcal{O}(1)\). A set with a single element.+singleton :: k -> POSet k+singleton k = POSet (POMap.singleton k ())+{-# INLINE singleton #-}+-- INLINE means we don't need to SPECIALIZE++-- | \(\mathcal{O}(w\log n)\).+-- If the key is already present in the map, the associated value is+-- replaced with the supplied value. 'insert' is equivalent to+-- @'insertWith' 'const'@.+insert :: (PartialOrd k) => k -> POSet k -> POSet k+insert k = coerce (POMap.insert k ())+{-# INLINE insert #-}++-- | \(\mathcal{O}(w\log n)\).+-- Delete an element from a set.+delete :: (PartialOrd k) => k -> POSet k -> POSet k+delete = coerce (POMap.delete @_ @())+{-# INLINE delete #-}++--+-- * Combine+--++-- ** Union++-- | \(\mathcal{O}(wn\log n)\), where \(n=\max(n_1,n_2)\) and \(w=\max(w_1,w_2)\).+-- The union of two sets, preferring the first set when+-- equal elements are encountered.+union :: PartialOrd k => POSet k -> POSet k -> POSet k+union = coerce (POMap.union @_ @())+{-# INLINE union #-}++-- | \(\mathcal{O}(wn\log n)\), where \(n=\max_i n_i\) and \(w=\max_i w_i\).+-- The union of a list of sets: (@'unions' == 'foldl' 'union' 'empty'@).+unions :: PartialOrd k => [POSet k] -> POSet k+unions = coerce (POMap.unions @_ @())+{-# INLINE unions #-}++-- ** Difference++-- | \(\mathcal{O}(wn\log n)\), where \(n=\max(n_1,n_2)\) and \(w=\max(w_1,w_2)\).+-- Difference of two sets.+difference :: PartialOrd k => POSet k -> POSet k -> POSet k+difference = coerce (POMap.difference @_ @() @())+{-# INLINE difference #-}++-- ** Intersection++-- | \(\mathcal{O}(wn\log n)\), where \(n=\max(n_1,n_2)\) and \(w=\max(w_1,w_2)\).+-- The intersection of two sets.+-- Elements of the result come from the first set, so for example+--+-- >>> data AB = A | B deriving Show+-- >>> instance Eq AB where _ == _ = True+-- >>> instance PartialOrd AB where _ `leq` _ = True+-- >>> singleton A `intersection` singleton B+-- fromList [A]+-- >>> singleton B `intersection` singleton A+-- fromList [B]+intersection :: PartialOrd k => POSet k -> POSet k -> POSet k+intersection = coerce (POMap.intersection @_ @() @())+{-# INLINE intersection #-}++--+-- * Filter+--++-- | \(\mathcal{O}(n)\).+-- Filter all elements that satisfy the predicate.+filter :: (k -> Bool) -> POSet k -> POSet k+filter f = coerce (POMap.filterWithKey @_ @() (\k _ -> f k))+{-# INLINE filter #-}++-- | \(\mathcal{O}(n)\).+-- 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.+partition :: (k -> Bool) -> POSet k -> (POSet k, POSet k)+partition f = coerce (POMap.partitionWithKey @_ @() (\k _ -> f k))+{-# INLINE partition #-}++-- | \(\mathcal{O}(log n)\). Take while a predicate on the keys holds.+-- The user is responsible for ensuring that for all elements @j@ and @k@ in the set,+-- @j \< k ==\> p j \>= p k@. See note at 'spanAntitone'.+--+-- @+-- takeWhileAntitone p = 'filter' p+-- @+--+-- @since 0.0.1.0+takeWhileAntitone :: (k -> Bool) -> POSet k -> POSet k+takeWhileAntitone = coerce (POMap.takeWhileAntitone @_ @())++-- | \(\mathcal{O}(log n)\). Drop while a predicate on the keys holds.+-- The user is responsible for ensuring that for all elements @j@ and @k@ in the set,+-- @j \< k ==\> p j \>= p k@. See note at 'spanAntitone'.+--+-- @+-- dropWhileAntitone p = 'filter' (not . p)+-- @+--+-- @since 0.0.1.0+dropWhileAntitone :: (k -> Bool) -> POSet k -> POSet k+dropWhileAntitone = coerce (POMap.dropWhileAntitone @_ @())++-- | \(\mathcal{O}(log n)\). Divide a set at the point where a predicate on the keys stops holding.+-- The user is responsible for ensuring that for all elements @j@ and @k@ in the set,+-- @j \< k ==\> p j \>= p k@.+--+-- @+-- spanAntitone p xs = 'partition' p xs+-- @+--+-- Note: if @p@ is not actually antitone, then @spanAntitone@ will split the set+-- at some /unspecified/ point where the predicate switches from holding to not+-- holding (where the predicate is seen to hold before the first element and to fail+-- after the last element).+--+-- @since 0.0.1.0+spanAntitone :: (k -> Bool) -> POSet k -> (POSet k, POSet k)+spanAntitone = coerce (POMap.spanAntitone @_ @())++--+-- * Map+--++-- | \(\mathcal{O}(wn\log n)\).+-- @'map' f s@ is the set obtained by applying @f@ to each element of @s@.+--+-- It's worth noting that the size of the result may be smaller if,+-- for some @(x,y)@, @x \/= y && f x == f y@+map :: PartialOrd k2 => (k1 -> k2) -> POSet k1 -> POSet k2+map = coerce (POMap.mapKeys @_ @_ @())+{-# INLINE map #-}++-- | \(\mathcal{O}(n)\).+-- @'mapMonotonic' f s == 'map' f s@, but works only when @f@ is strictly increasing.+-- /The precondition is not checked./+-- Semi-formally, for every chain @ls@ in @s@ we have:+--+-- > and [x < y ==> f x < f y | x <- ls, y <- ls]+-- >                     ==> mapMonotonic f s == map f s+mapMonotonic :: (k1 -> k2) -> POSet k1 -> POSet k2+mapMonotonic = coerce (POMap.mapKeysMonotonic @_ @_ @())+{-# INLINE mapMonotonic #-}++--+-- * Folds+--++-- | \(\mathcal{O}(n)\).+-- A strict version of 'foldr'. Each application of the operator is+-- evaluated before using the result in the next application. This+-- function is strict in the starting value.+foldr' :: (a -> b -> b) -> b -> POSet a -> b+foldr' f = coerce (POMap.foldrWithKey' @_ @()  (\k _ acc -> f k acc))+{-# INLINE foldr' #-}++-- | \(\mathcal{O}(n)\).+-- A strict version of 'foldl'. Each application of the operator is+-- evaluated before using the result in the next application. This+-- function is strict in the starting value.+foldl' :: (b -> a -> b) -> b -> POSet a -> b+foldl' f = coerce (POMap.foldlWithKey' @_ @_ @()  (\k acc _ -> f k acc))+{-# INLINE foldl' #-}++--+-- * Min/Max+--++-- | \(\mathcal{O}(w\log n)\).+-- The minimal keys of the set.+lookupMin :: PartialOrd k => POSet k -> [k]+lookupMin = List.map @(_,()) fst . coerce (POMap.lookupMin @_ @())+{-# INLINE lookupMin #-}++-- | \(\mathcal{O}(w\log n)\).+-- The maximal keys of the set.+lookupMax :: PartialOrd k => POSet k -> [k]+lookupMax = List.map @(_,()) fst . coerce (POMap.lookupMax @_ @())+{-# INLINE lookupMax #-}++--+-- * Conversion+--++-- | \(\mathcal{O}(n)\).+-- The elements of a set in unspecified order.+elems :: POSet k -> [k]+elems = coerce (POMap.keys @_ @())+{-# INLINE elems #-}++-- | \(\mathcal{O}(n)\).+-- The elements of a set in unspecified order.+toList :: POSet k -> [k]+toList = coerce (POMap.keys @_ @())+{-# INLINE toList #-}++-- | \(\mathcal{O}(wn\log n)\).+-- Build a set from a list of keys.+fromList :: (PartialOrd k) => [k] -> POSet k+fromList = coerce (POMap.fromList @_ @()) . List.map (, ())+{-# INLINE fromList #-}

stack.yaml view

@@ -1,63 +1,63 @@-# This file was automatically generated by 'stack init'
-#
-# Some commonly used options have been documented as comments in this file.
-# For advanced use and comprehensive documentation of the format, please see:
-# http://docs.haskellstack.org/en/stable/yaml_configuration/
-
-# Resolver to choose a 'specific' stackage snapshot or a compiler version.
-# A snapshot resolver dictates the compiler version and the set of packages
-# to be used for project dependencies. For example:
-#
-# resolver: lts-3.5
-# resolver: nightly-2015-09-21
-# resolver: ghc-7.10.2
-# resolver: ghcjs-0.1.0_ghc-7.10.2
-# resolver:
-#  name: custom-snapshot
-#  location: "./custom-snapshot.yaml"
-resolver: lts-11.1
-
-# User packages to be built.
-# Various formats can be used as shown in the example below.
-#
-# packages:
-# - some-directory
-# - https://example.com/foo/bar/baz-0.0.2.tar.gz
-# - location:
-#    git: https://github.com/commercialhaskell/stack.git
-#    commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
-# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
-#   extra-dep: true
-#  subdirs:
-#  - auto-update
-#  - wai
-#
-# A package marked 'extra-dep: true' will only be built if demanded by a
-# non-dependency (i.e. a user package), and its test suites and benchmarks
-# will not be run. This is useful for tweaking upstream packages.
-packages:
-- '.'
-# Dependency packages to be pulled from upstream that are not in the resolver
-# (e.g., acme-missiles-0.3)
-extra-deps: []
-
-# Extra package databases containing global packages
-extra-package-dbs: []
-
-# Control whether we use the GHC we find on the path
-# system-ghc: true
-#
-# Require a specific version of stack, using version ranges
-# require-stack-version: -any # Default
-# require-stack-version: ">=1.4"
-#
-# Override the architecture used by stack, especially useful on Windows
-# arch: i386
-# arch: x86_64
-#
-# Extra directories used by stack for building
-# extra-include-dirs: [/path/to/dir]
-# extra-lib-dirs: [/path/to/dir]
-#
-# Allow a newer minor version of GHC than the snapshot specifies
-# compiler-check: newer-minor
+# This file was automatically generated by 'stack init'+#+# Some commonly used options have been documented as comments in this file.+# For advanced use and comprehensive documentation of the format, please see:+# http://docs.haskellstack.org/en/stable/yaml_configuration/++# Resolver to choose a 'specific' stackage snapshot or a compiler version.+# A snapshot resolver dictates the compiler version and the set of packages+# to be used for project dependencies. For example:+#+# resolver: lts-3.5+# resolver: nightly-2015-09-21+# resolver: ghc-7.10.2+# resolver: ghcjs-0.1.0_ghc-7.10.2+# resolver:+#  name: custom-snapshot+#  location: "./custom-snapshot.yaml"+resolver: lts-11.1++# User packages to be built.+# Various formats can be used as shown in the example below.+#+# packages:+# - some-directory+# - https://example.com/foo/bar/baz-0.0.2.tar.gz+# - location:+#    git: https://github.com/commercialhaskell/stack.git+#    commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a+# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a+#   extra-dep: true+#  subdirs:+#  - auto-update+#  - wai+#+# A package marked 'extra-dep: true' will only be built if demanded by a+# non-dependency (i.e. a user package), and its test suites and benchmarks+# will not be run. This is useful for tweaking upstream packages.+packages:+- '.'+# Dependency packages to be pulled from upstream that are not in the resolver+# (e.g., acme-missiles-0.3)+extra-deps: []++# Extra package databases containing global packages+extra-package-dbs: []++# Control whether we use the GHC we find on the path+# system-ghc: true+#+# Require a specific version of stack, using version ranges+# require-stack-version: -any # Default+# require-stack-version: ">=1.4"+#+# Override the architecture used by stack, especially useful on Windows+# arch: i386+# arch: x86_64+#+# Extra directories used by stack for building+# extra-include-dirs: [/path/to/dir]+# extra-lib-dirs: [/path/to/dir]+#+# Allow a newer minor version of GHC than the snapshot specifies+# compiler-check: newer-minor

tests/Data/POMap/Properties.hs view

@@ -17,7 +17,6 @@ import qualified Data.List               as List
 import qualified Data.Maybe              as Maybe
 import           Data.Monoid             (Dual (..), Endo (..), Sum (..))
-import           Data.Ord                (comparing)
 import           Data.POMap.Arbitrary    ()
 import           Data.POMap.Divisibility
 import           Data.POMap.Lazy
@@ -29,7 +28,7 @@ type DivMap v = POMap Divisibility v
 
 instance {-# OVERLAPPING #-} Eq v => Eq (DivMap v) where
-  (==) = (==) `on` List.sortBy (comparing (unDiv . fst)) . toList
+  (==) = (==) `on` List.sortOn (unDiv . fst) . toList
 
 div' :: Int -> DivMap Integer
 div' = fromList . divisibility
@@ -52,7 +51,7 @@ makeEntries = fmap (Div &&& id)
 
 shouldBeSameEntries :: (Eq v, Show v) => [(Divisibility, v)] -> [(Divisibility, v)] -> Expectation
-shouldBeSameEntries = shouldBe `on` List.sortBy (comparing (unDiv . fst))
+shouldBeSameEntries = shouldBe `on` List.sortOn (unDiv . fst)
 
 isAntichain :: PartialOrd k => [k] -> Bool
 isAntichain []     = True
@@ -399,6 +398,18 @@       let p k v = odd (unDiv k + v)
       it "partitionWithKey p = filterWithKey p &&& filterWithKey ((not .) . p)" $ property $ \(m :: DivMap Integer) ->
         partitionWithKey p m `shouldBe` (filterWithKey p &&& filterWithKey ((not .) . p)) m
+    describe "takeWhileAntitone" $ do
+      let p k = unDiv k < 50
+      it "takeWhileAntitone p = filterWithKey (\\k _ -> p k)" $ property $ \(m :: DivMap Int) ->
+        takeWhileAntitone p m `shouldBe` filterWithKey (\k _ -> p k) m
+    describe "dropWhileAntitone" $ do
+      let p k = unDiv k < 50
+      it "dropWhileAntitone p = filterWithKey (\\k _ -> not (p k))" $ property $ \(m :: DivMap Int) ->
+        dropWhileAntitone p m `shouldBe` filterWithKey (\k _ -> not (p k)) m
+    describe "spanAntitone" $ do
+      let p k = unDiv k < 50
+      it "spanAntitone p = partitionWithKey (\\k _ -> p k)" $ property $ \(m :: DivMap Int) ->
+        spanAntitone p m `shouldBe` partitionWithKey (\k _ -> p k) m
     describe "mapMaybe" $ do
       let f v = if odd v then Just (v + 1) else Nothing
       it "mapMaybe f = fromList . Maybe.mapMaybe (traverse f) . toList" $ property $ \(m :: DivMap Int) ->

tests/Data/POMap/Strictness.hs view

@@ -19,7 +19,7 @@ type DivMap v = L.POMap Divisibility v
 
 instance {-# OVERLAPPING #-} Eq v => Eq (DivMap v) where
-  (==) = (==) `on` List.sortBy (comparing (unDiv . fst)) . toList
+  (==) = (==) `on` List.sortOn (unDiv . fst) . toList
 
 shouldBeBottom :: a -> Expectation
 shouldBeBottom x = isBottom x `shouldBe` True

tests/Main.hs view

@@ -1,13 +1,13 @@-import qualified Data.POMap.Properties
-import qualified Data.POMap.Strictness
-import qualified Test.Tasty
-import           Test.Tasty.Hspec
-
-main :: IO ()
-main = do
-  props <- testSpec "properties" (parallel Data.POMap.Properties.spec)
-  strict <- testSpec "strictness" (parallel Data.POMap.Strictness.spec)
-  Test.Tasty.defaultMain $ Test.Tasty.testGroup "pomaps"
-    [ props
-    , strict
-    ]
+import qualified Data.POMap.Properties+import qualified Data.POMap.Strictness+import qualified Test.Tasty+import           Test.Tasty.Hspec++main :: IO ()+main = do+  props <- testSpec "properties" (parallel Data.POMap.Properties.spec)+  strict <- testSpec "strictness" (parallel Data.POMap.Strictness.spec)+  Test.Tasty.defaultMain $ Test.Tasty.testGroup "pomaps"+    [ props+    , strict+    ]

tests/doctest-driver.hs view

@@ -1,5 +1,5 @@-import           System.FilePath.Glob (glob)
-import           Test.DocTest         (doctest)
-
-main :: IO ()
-main = glob "src/**/*.hs" >>= doctest
+import           System.FilePath.Glob (glob)+import           Test.DocTest         (doctest)++main :: IO ()+main = glob "src/**/*.hs" >>= doctest