psqueues 0.2.3.0 → 0.2.4.0
raw patch · 10 files changed
+185/−94 lines, 10 filesdep ~hashable
Dependency ranges changed: hashable
Files
- CHANGELOG +6/−0
- psqueues.cabal +6/−6
- src/Data/HashPSQ.hs +1/−0
- src/Data/HashPSQ/Internal.hs +18/−0
- src/Data/IntPSQ.hs +1/−0
- src/Data/IntPSQ/Internal.hs +18/−0
- src/Data/OrdPSQ.hs +1/−0
- src/Data/OrdPSQ/Internal.hs +26/−0
- tests/Data/PSQ/Class.hs +71/−66
- tests/Data/PSQ/Class/Tests.hs +37/−22
CHANGELOG view
@@ -1,3 +1,9 @@+- 0.2.4.0 (2017-09-27)+ * Add `unsafeMapMonotonic`+ * Lower build depends version for hashable+ * Move repo to `jaspervdj/psqueues` to enable travis+ * Lower build depends version for hashable+ - 0.2.3.0 * Add an `atMostView` function to all PSQ flavours * Bump HUnit dependency to 1.6
psqueues.cabal view
@@ -1,9 +1,9 @@ Name: psqueues-Version: 0.2.3.0+Version: 0.2.4.0 License: BSD3 License-file: LICENSE Maintainer: Jasper Van der Jeugt <jaspervdj@gmail.com>-Bug-reports: https://github.com/bttr/psqueues/issues+Bug-reports: https://github.com/jaspervdj/psqueues/issues Synopsis: Pure priority search queues Category: Data Structures Build-type: Simple@@ -57,16 +57,16 @@ Source-repository head type: git- location: http://github.com/bttr/psqueues.git+ location: http://github.com/jaspervdj/psqueues.git Library Ghc-options: -O2 -Wall Hs-source-dirs: src Build-depends:- base >= 4.2 && < 5- , deepseq >= 1.2 && < 1.5- , hashable >= 1.2.1 && < 1.3+ base >= 4.2 && < 5+ , deepseq >= 1.2 && < 1.5+ , hashable >= 1.1.2.3 && < 1.3 if impl(ghc>=6.10) Build-depends: ghc-prim
src/Data/HashPSQ.hs view
@@ -41,6 +41,7 @@ -- * Traversal , map+ , unsafeMapMonotonic , fold' -- * Validity check
src/Data/HashPSQ/Internal.hs view
@@ -43,6 +43,7 @@ -- * Traversal , map+ , unsafeMapMonotonic , fold' -- * Unsafe operations@@ -389,6 +390,23 @@ map f (HashPSQ ipsq) = HashPSQ (IntPSQ.map (\_ p v -> mapBucket p v) ipsq) where mapBucket p (B k v opsq) = B k (f k p v) (OrdPSQ.map f opsq)++-- | /O(n)/ Maps a function over the values and priorities of the queue.+-- The function @f@ must be monotonic with respect to the priorities. I.e. if+-- @x < y@, then @fst (f k x v) < fst (f k y v)@.+-- /The precondition is not checked./ If @f@ is not monotonic, then the result+-- will be invalid.+{-# INLINABLE unsafeMapMonotonic #-}+unsafeMapMonotonic+ :: (k -> p -> v -> (q, w))+ -> HashPSQ k p v+ -> HashPSQ k q w+unsafeMapMonotonic f (HashPSQ ipsq) =+ HashPSQ (IntPSQ.unsafeMapMonotonic (\_ p v -> mapBucket p v) ipsq)+ where+ mapBucket p (B k v opsq) =+ let (p', v') = f k p v+ in (p', B k v' (OrdPSQ.unsafeMapMonotonic f opsq)) -- | /O(n)/ Strict fold over every key, priority and value in the queue. The order -- in which the fold is performed is not specified.
src/Data/IntPSQ.hs view
@@ -44,6 +44,7 @@ -- * Traversal , map+ , unsafeMapMonotonic , fold' -- * Validity check
src/Data/IntPSQ/Internal.hs view
@@ -44,6 +44,7 @@ -- * Traversal , map+ , unsafeMapMonotonic , fold' -- * Unsafe manipulation@@ -463,6 +464,23 @@ Nil -> Nil Tip k p x -> Tip k p (f k p x) Bin k p x m l r -> Bin k p (f k p x) m (go l) (go r)++-- | /O(n)/ Maps a function over the values and priorities of the queue.+-- The function @f@ must be monotonic with respect to the priorities. I.e. if+-- @x < y@, then @fst (f k x v) < fst (f k y v)@.+-- /The precondition is not checked./ If @f@ is not monotonic, then the result+-- will be invalid.+{-# INLINABLE unsafeMapMonotonic #-}+unsafeMapMonotonic :: (Key -> p -> v -> (q, w)) -> IntPSQ p v -> IntPSQ q w+unsafeMapMonotonic f = go+ where+ go t = case t of+ Nil -> Nil+ Tip k p x -> let (p', x') = f k p x+ in Tip k p' x'++ Bin k p x m l r -> let (p', x') = f k p x+ in Bin k p' x' m (go l) (go r) -- | /O(n)/ Strict fold over every key, priority and value in the queue. The order -- in which the fold is performed is not specified.
src/Data/OrdPSQ.hs view
@@ -51,6 +51,7 @@ -- * Traversals , map+ , unsafeMapMonotonic , fold' -- * Validity check
src/Data/OrdPSQ/Internal.hs view
@@ -44,6 +44,7 @@ -- * Traversals , map+ , unsafeMapMonotonic , fold' -- * Tournament view@@ -393,6 +394,31 @@ goLTree (LLoser s e l k r) = LLoser s (goElem e) (goLTree l) k (goLTree r) goLTree (RLoser s e l k r) = RLoser s (goElem e) (goLTree l) k (goLTree r) +-- | /O(n)/ Maps a function over the values and priorities of the queue.+-- The function @f@ must be monotonic with respect to the priorities. I.e. if+-- @x < y@, then @fst (f k x v) < fst (f k y v)@.+-- /The precondition is not checked./ If @f@ is not monotonic, then the result+-- will be invalid.+{-# INLINABLE unsafeMapMonotonic #-}+unsafeMapMonotonic+ :: forall k p q v w.+ (k -> p -> v -> (q, w))+ -> OrdPSQ k p v+ -> OrdPSQ k q w+unsafeMapMonotonic f = goPSQ+ where+ goPSQ :: OrdPSQ k p v -> OrdPSQ k q w+ goPSQ Void = Void+ goPSQ (Winner e l k) = Winner (goElem e) (goLTree l) k++ goElem :: Elem k p v -> Elem k q w+ goElem (E k p x) = let (p', x') = f k p x+ in E k p' x'++ goLTree :: LTree k p v -> LTree k q w+ goLTree Start = Start+ goLTree (LLoser s e l k r) = LLoser s (goElem e) (goLTree l) k (goLTree r)+ goLTree (RLoser s e l k r) = RLoser s (goElem e) (goLTree l) k (goLTree r) -- | /O(n)/ Strict fold over every key, priority and value in the queue. The order -- in which the fold is performed is not specified.
tests/Data/PSQ/Class.hs view
@@ -73,6 +73,8 @@ -- Traversals map :: Ord p => (Key psq -> p -> v -> w) -> psq p v -> psq p w+ unsafeMapMonotonic+ :: (Ord p, Ord q) => (Key psq -> p -> v -> (q, w)) -> psq p v -> psq q w fold' :: Ord p => (Key psq -> p -> v -> a -> a) -> a -> psq p v -> a @@ -83,77 +85,80 @@ instance PSQ IntPSQ.IntPSQ where type Key IntPSQ.IntPSQ = Int - null = IntPSQ.null- size = IntPSQ.size- member = IntPSQ.member- lookup = IntPSQ.lookup- findMin = IntPSQ.findMin- empty = IntPSQ.empty- singleton = IntPSQ.singleton- insert = IntPSQ.insert- delete = IntPSQ.delete- deleteMin = IntPSQ.deleteMin- alter = IntPSQ.alter- alterMin = IntPSQ.alterMin- fromList = IntPSQ.fromList- toList = IntPSQ.toList- keys = IntPSQ.keys- insertView = IntPSQ.insertView- deleteView = IntPSQ.deleteView- minView = IntPSQ.minView- atMostView = IntPSQ.atMostView- map = IntPSQ.map- fold' = IntPSQ.fold'- valid = IntPSQ.valid+ null = IntPSQ.null+ size = IntPSQ.size+ member = IntPSQ.member+ lookup = IntPSQ.lookup+ findMin = IntPSQ.findMin+ empty = IntPSQ.empty+ singleton = IntPSQ.singleton+ insert = IntPSQ.insert+ delete = IntPSQ.delete+ deleteMin = IntPSQ.deleteMin+ alter = IntPSQ.alter+ alterMin = IntPSQ.alterMin+ fromList = IntPSQ.fromList+ toList = IntPSQ.toList+ keys = IntPSQ.keys+ insertView = IntPSQ.insertView+ deleteView = IntPSQ.deleteView+ minView = IntPSQ.minView+ atMostView = IntPSQ.atMostView+ map = IntPSQ.map+ unsafeMapMonotonic = IntPSQ.unsafeMapMonotonic+ fold' = IntPSQ.fold'+ valid = IntPSQ.valid instance forall k. Ord k => PSQ (OrdPSQ.OrdPSQ k) where type Key (OrdPSQ.OrdPSQ k) = k - null = OrdPSQ.null- size = OrdPSQ.size- member = OrdPSQ.member- lookup = OrdPSQ.lookup- findMin = OrdPSQ.findMin- empty = OrdPSQ.empty- singleton = OrdPSQ.singleton- insert = OrdPSQ.insert- delete = OrdPSQ.delete- deleteMin = OrdPSQ.deleteMin- alter = OrdPSQ.alter- alterMin = OrdPSQ.alterMin- fromList = OrdPSQ.fromList- toList = OrdPSQ.toList- keys = OrdPSQ.keys- insertView = OrdPSQ.insertView- deleteView = OrdPSQ.deleteView- minView = OrdPSQ.minView- atMostView = OrdPSQ.atMostView- map = OrdPSQ.map- fold' = OrdPSQ.fold'- valid = OrdPSQ.valid+ null = OrdPSQ.null+ size = OrdPSQ.size+ member = OrdPSQ.member+ lookup = OrdPSQ.lookup+ findMin = OrdPSQ.findMin+ empty = OrdPSQ.empty+ singleton = OrdPSQ.singleton+ insert = OrdPSQ.insert+ delete = OrdPSQ.delete+ deleteMin = OrdPSQ.deleteMin+ alter = OrdPSQ.alter+ alterMin = OrdPSQ.alterMin+ fromList = OrdPSQ.fromList+ toList = OrdPSQ.toList+ keys = OrdPSQ.keys+ insertView = OrdPSQ.insertView+ deleteView = OrdPSQ.deleteView+ minView = OrdPSQ.minView+ atMostView = OrdPSQ.atMostView+ map = OrdPSQ.map+ unsafeMapMonotonic = OrdPSQ.unsafeMapMonotonic+ fold' = OrdPSQ.fold'+ valid = OrdPSQ.valid instance forall k. (Hashable k, Ord k) => PSQ (HashPSQ.HashPSQ k) where type Key (HashPSQ.HashPSQ k) = k - null = HashPSQ.null- size = HashPSQ.size- member = HashPSQ.member- lookup = HashPSQ.lookup- findMin = HashPSQ.findMin- empty = HashPSQ.empty- singleton = HashPSQ.singleton- insert = HashPSQ.insert- delete = HashPSQ.delete- deleteMin = HashPSQ.deleteMin- alter = HashPSQ.alter- alterMin = HashPSQ.alterMin- fromList = HashPSQ.fromList- toList = HashPSQ.toList- keys = HashPSQ.keys- insertView = HashPSQ.insertView- deleteView = HashPSQ.deleteView- minView = HashPSQ.minView- atMostView = HashPSQ.atMostView- map = HashPSQ.map- fold' = HashPSQ.fold'- valid = HashPSQ.valid+ null = HashPSQ.null+ size = HashPSQ.size+ member = HashPSQ.member+ lookup = HashPSQ.lookup+ findMin = HashPSQ.findMin+ empty = HashPSQ.empty+ singleton = HashPSQ.singleton+ insert = HashPSQ.insert+ delete = HashPSQ.delete+ deleteMin = HashPSQ.deleteMin+ alter = HashPSQ.alter+ alterMin = HashPSQ.alterMin+ fromList = HashPSQ.fromList+ toList = HashPSQ.toList+ keys = HashPSQ.keys+ insertView = HashPSQ.insertView+ deleteView = HashPSQ.deleteView+ minView = HashPSQ.minView+ atMostView = HashPSQ.atMostView+ map = HashPSQ.map+ unsafeMapMonotonic = HashPSQ.unsafeMapMonotonic+ fold' = HashPSQ.fold'+ valid = HashPSQ.valid
tests/Data/PSQ/Class/Tests.hs view
@@ -52,28 +52,29 @@ , testCase "fromList" (untag' test_fromList) , testCase "foldr" (untag' test_foldr) - , testProperty "show" (untag' prop_show)- , testProperty "rnf" (untag' prop_rnf)- , testProperty "size" (untag' prop_size)- , testProperty "singleton" (untag' prop_singleton)- , testProperty "memberLookup" (untag' prop_memberLookup)- , testProperty "insertLookup" (untag' prop_insertLookup)- , testProperty "insertDelete" (untag' prop_insertDelete)- , testProperty "insertDeleteView" (untag' prop_insertDeleteView)- , testProperty "deleteNonMember" (untag' prop_deleteNonMember)- , testProperty "deleteMin" (untag' prop_deleteMin)- , testProperty "alter" (untag' prop_alter)- , testProperty "alterMin" (untag' prop_alterMin)- , testProperty "toList" (untag' prop_toList)- , testProperty "keys" (untag' prop_keys)- , testProperty "insertView" (untag' prop_insertView)- , testProperty "deleteView" (untag' prop_deleteView)- , testProperty "map" (untag' prop_map)- , testProperty "fmap" (untag' prop_fmap)- , testProperty "fold'" (untag' prop_fold')- , testProperty "foldr" (untag' prop_foldr)- , testProperty "valid" (untag' prop_valid)- , testProperty "atMostView" (untag' prop_atMostView)+ , testProperty "show" (untag' prop_show)+ , testProperty "rnf" (untag' prop_rnf)+ , testProperty "size" (untag' prop_size)+ , testProperty "singleton" (untag' prop_singleton)+ , testProperty "memberLookup" (untag' prop_memberLookup)+ , testProperty "insertLookup" (untag' prop_insertLookup)+ , testProperty "insertDelete" (untag' prop_insertDelete)+ , testProperty "insertDeleteView" (untag' prop_insertDeleteView)+ , testProperty "deleteNonMember" (untag' prop_deleteNonMember)+ , testProperty "deleteMin" (untag' prop_deleteMin)+ , testProperty "alter" (untag' prop_alter)+ , testProperty "alterMin" (untag' prop_alterMin)+ , testProperty "toList" (untag' prop_toList)+ , testProperty "keys" (untag' prop_keys)+ , testProperty "insertView" (untag' prop_insertView)+ , testProperty "deleteView" (untag' prop_deleteView)+ , testProperty "map" (untag' prop_map)+ , testProperty "unsafeMapMonotonic" (untag' prop_unsafeMapMonotonic)+ , testProperty "fmap" (untag' prop_fmap)+ , testProperty "fold'" (untag' prop_fold')+ , testProperty "foldr" (untag' prop_foldr)+ , testProperty "valid" (untag' prop_valid)+ , testProperty "atMostView" (untag' prop_atMostView) ] where untag' :: Tagged psq test -> test@@ -397,6 +398,20 @@ fromList (List.map (\(k, p, x) -> (k, p, f k p x)) (toList t)) where f k p x = if fromEnum k > p then x else 'a'++prop_unsafeMapMonotonic+ :: forall psq. (PSQ psq, TestKey (Key psq),+ Arbitrary (psq Int Char),+ Eq (psq Int Char),+ Show (psq Int Char))+ => Tagged psq (psq Int Char -> Bool)+prop_unsafeMapMonotonic = Tagged $ \t ->+ let t' = unsafeMapMonotonic f (t :: psq Int Char) :: psq Int Char in+ valid t' &&+ t' == fromList (List.map (\(k, p, x) -> let (p', x') = f k p x in (k, p', x'))+ (toList t))+ where+ f k p x = (p + 1, if fromEnum k > p then x else 'a') prop_fmap :: forall psq. (PSQ psq, TestKey (Key psq),