psqueues 0.2.2.3 → 0.2.3.0
raw patch · 11 files changed
+150/−33 lines, 11 filesdep ~HUnitdep ~QuickCheck
Dependency ranges changed: HUnit, QuickCheck
Files
- CHANGELOG +6/−0
- psqueues.cabal +21/−8
- src/Data/HashPSQ.hs +1/−0
- src/Data/HashPSQ/Internal.hs +39/−2
- src/Data/IntPSQ.hs +1/−0
- src/Data/IntPSQ/Internal.hs +30/−13
- src/Data/OrdPSQ.hs +3/−3
- src/Data/OrdPSQ/Internal.hs +26/−6
- tests/Data/PSQ/Class.hs +5/−0
- tests/Data/PSQ/Class/Tests.hs +17/−0
- tests/Data/PSQ/Class/Util.hs +1/−1
CHANGELOG view
@@ -1,3 +1,9 @@+- 0.2.3.0+ * Add an `atMostView` function to all PSQ flavours+ * Bump HUnit dependency to 1.6+ * Bump QuickCheck dependency to 2.10+ * Clean up warnings on newer and older GHC versions+ - 0.2.2.3 * Bump HUnit dependency to 1.5
psqueues.cabal view
@@ -1,5 +1,5 @@ Name: psqueues-Version: 0.2.2.3+Version: 0.2.3.0 License: BSD3 License-file: LICENSE Maintainer: Jasper Van der Jeugt <jaspervdj@gmail.com>@@ -85,17 +85,23 @@ Type: exitcode-stdio-1.0 Hs-source-dirs: src benchmarks Main-is: Main.hs+ Ghc-options: -Wall Other-modules: BenchmarkTypes+ Data.BitUtil Data.FingerTree.PSQueue.Benchmark+ Data.HashPSQ Data.HashPSQ.Benchmark+ Data.HashPSQ.Internal+ Data.IntPSQ Data.IntPSQ.Benchmark+ Data.IntPSQ.Internal+ Data.OrdPSQ Data.OrdPSQ.Benchmark+ Data.OrdPSQ.Internal Data.PSQueue.Benchmark - Ghc-options: -Wall- Build-depends: containers >= 0.5 , unordered-containers >= 0.2.4@@ -119,17 +125,24 @@ Type: exitcode-stdio-1.0 Other-modules:+ Data.BitUtil+ Data.HashPSQ+ Data.HashPSQ.Internal+ Data.HashPSQ.Tests+ Data.IntPSQ+ Data.IntPSQ.Internal+ Data.IntPSQ.Tests+ Data.OrdPSQ+ Data.OrdPSQ.Internal+ Data.OrdPSQ.Tests Data.PSQ.Class Data.PSQ.Class.Gen Data.PSQ.Class.Tests Data.PSQ.Class.Util- Data.HashPSQ.Tests- Data.IntPSQ.Tests- Data.OrdPSQ.Tests Build-depends:- HUnit >= 1.2 && < 1.6- , QuickCheck >= 2.7 && < 2.10+ HUnit >= 1.2 && < 1.7+ , QuickCheck >= 2.7 && < 2.11 , test-framework >= 0.8 && < 0.9 , test-framework-hunit >= 0.3 && < 0.4 , test-framework-quickcheck2 >= 0.3 && < 0.4
src/Data/HashPSQ.hs view
@@ -37,6 +37,7 @@ , insertView , deleteView , minView+ , atMostView -- * Traversal , map
src/Data/HashPSQ/Internal.hs view
@@ -39,6 +39,7 @@ , insertView , deleteView , minView+ , atMostView -- * Traversal , map@@ -54,12 +55,12 @@ ) where import Control.DeepSeq (NFData (..))-import Data.Foldable (Foldable (foldr))+import Data.Foldable (Foldable) import Data.Hashable import qualified Data.List as List import Data.Maybe (isJust)-import Prelude hiding (foldr, lookup, map, null) import Data.Traversable+import Prelude hiding (foldr, lookup, map, null) import qualified Data.IntPSQ.Internal as IntPSQ import qualified Data.OrdPSQ as OrdPSQ@@ -340,6 +341,42 @@ (Just (k, p, x), Nothing) Just (k', p', x', os') -> (Just (k, p, x), Just (h, p', B k' x' os'))++-- | Return a list of elements ordered by key whose priorities are at most @pt@,+-- and the rest of the queue stripped of these elements. The returned list of+-- elements can be in any order: no guarantees there.+{-# INLINABLE atMostView #-}+atMostView+ :: (Hashable k, Ord k, Ord p)+ => p -> HashPSQ k p v -> ([(k, p, v)], HashPSQ k p v)+atMostView pt (HashPSQ t0) =+ (returns, HashPSQ t2)+ where+ -- First we use 'IntPSQ.atMostView' to get a collection of buckets that have+ -- /AT LEAST/ one element with a low priority. Buckets will usually only+ -- contain a single element.+ (buckets, t1) = IntPSQ.atMostView pt t0++ -- We now need to run through the buckets. This will give us a list of+ -- elements to return and a bunch of buckets to re-insert.+ (returns, reinserts) = go [] [] buckets+ where+ -- We use two accumulators, for returns and re-inserts.+ go rets reins [] = (rets, reins)+ go rets reins ((_, p, B k v opsq) : bs) =+ -- Note that 'elems' should be very small, ideally a null list.+ let (elems, opsq') = OrdPSQ.atMostView pt opsq+ rets' = (k, p, v) : elems ++ rets+ reins' = case toBucket opsq' of+ Nothing -> reins+ Just (p', b) -> ((p', b) : reins)+ in go rets' reins' bs++ -- Now we can do the re-insertion pass.+ t2 = List.foldl'+ (\t (p, b@(B k _ _)) -> IntPSQ.unsafeInsertNew (hash k) p b t)+ t1+ reinserts --------------------------------------------------------------------------------
src/Data/IntPSQ.hs view
@@ -40,6 +40,7 @@ , insertView , deleteView , minView+ , atMostView -- * Traversal , map
src/Data/IntPSQ/Internal.hs view
@@ -40,6 +40,7 @@ , insertView , deleteView , minView+ , atMostView -- * Traversal , map@@ -63,21 +64,17 @@ import Control.Applicative ((<$>), (<*>)) import Control.DeepSeq (NFData (rnf))- import Data.Bits import Data.BitUtil-import Data.Foldable (Foldable (foldr))+import Data.Foldable (Foldable) import Data.List (foldl')+import qualified Data.List as List import Data.Maybe (isJust)+import Data.Traversable import Data.Word (Word)--import qualified Data.List as List- import Prelude hiding (filter, foldl, foldr, lookup, map, null) -import Data.Traversable- -- TODO (SM): get rid of bang patterns {-@@ -197,9 +194,9 @@ -- | /O(1)/ The element with the lowest priority. findMin :: Ord p => IntPSQ p v -> Maybe (Int, p, v) findMin t = case t of- Nil -> Nothing- Tip k p x -> Just (k, p, x)- Bin k p x _ _ _ -> Just (k, p, x)+ Nil -> Nothing+ Tip k p x -> Just (k, p, x)+ Bin k p x _ _ _ -> Just (k, p, x) ------------------------------------------------------------------------------@@ -370,7 +367,7 @@ toList = go [] where- go acc Nil = acc+ go acc Nil = acc go acc (Tip k' p' x') = (k', p', x') : acc go acc (Bin k' p' x' _m l r) = (k', p', x') : go (go acc r) l @@ -431,7 +428,27 @@ Tip k p x -> Just (k, p, x, Nil) Bin k p x m l r -> Just (k, p, x, merge m l r) +-- | Return a list of elements ordered by key whose priorities are at most @pt@,+-- and the rest of the queue stripped of these elements. The returned list of+-- elements can be in any order: no guarantees there.+{-# INLINABLE atMostView #-}+atMostView :: Ord p => p -> IntPSQ p v -> ([(Int, p, v)], IntPSQ p v)+atMostView pt t0 = go [] t0+ where+ go acc t = case t of+ Nil -> (acc, t)+ Tip k p x+ | p > pt -> (acc, t)+ | otherwise -> ((k, p, x) : acc, Nil) + Bin k p x m l r+ | p > pt -> (acc, t)+ | otherwise ->+ let (acc', l') = go acc l+ (acc'', r') = go acc' r+ in ((k, p, x) : acc'', merge m l' r')++ ------------------------------------------------------------------------------ -- Traversal ------------------------------------------------------------------------------@@ -696,6 +713,6 @@ Just xoredKeys -> fromIntegral mask == highestBitMask (fromIntegral xoredKeys) - childKey Nil = Nothing- childKey (Tip k _ _) = Just k+ childKey Nil = Nothing+ childKey (Tip k _ _) = Just k childKey (Bin k _ _ _ _ _) = Just k
src/Data/OrdPSQ.hs view
@@ -11,9 +11,8 @@ -- This means it is similar to the -- <http://hackage.haskell.org/package/PSQueue-1.1 PSQueue> package but -- our benchmarks showed it perform quite a bit faster.+{-# LANGUAGE Safe #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE Trustworthy #-}-{-# LANGUAGE BangPatterns #-} module Data.OrdPSQ ( -- * Type OrdPSQ@@ -48,6 +47,7 @@ , insertView , deleteView , minView+ , atMostView -- * Traversals , map@@ -57,6 +57,6 @@ , valid ) where -import Prelude hiding (map, lookup, null, foldr)+import Prelude hiding (foldr, lookup, map, null) import Data.OrdPSQ.Internal
src/Data/OrdPSQ/Internal.hs view
@@ -2,8 +2,8 @@ {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE Safe #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE Trustworthy #-} module Data.OrdPSQ.Internal ( -- * Type OrdPSQ (..)@@ -40,6 +40,7 @@ , insertView , deleteView , minView+ , atMostView -- * Traversals , map@@ -67,12 +68,12 @@ , valid ) where -import Control.DeepSeq (NFData (rnf))-import Data.Foldable (Foldable (foldr))-import qualified Data.List as List-import Data.Maybe (isJust)-import Prelude hiding (foldr, lookup, map, null)+import Control.DeepSeq (NFData (rnf))+import Data.Foldable (Foldable (foldr))+import qualified Data.List as List+import Data.Maybe (isJust) import Data.Traversable+import Prelude hiding (foldr, lookup, map, null) -------------------------------------------------------------------------------- -- Types@@ -349,6 +350,25 @@ secondBest Start _ = Void secondBest (LLoser _ e tl m tr) m' = Winner e tl m `play` secondBest tr m' secondBest (RLoser _ e tl m tr) m' = secondBest tl m `play` Winner e tr m'++-- | Return a list of elements ordered by key whose priorities are at most @pt@,+-- and the rest of the queue stripped of these elements. The returned list of+-- elements can be in any order: no guarantees there.+atMostView :: (Ord k, Ord p) => p -> OrdPSQ k p v -> ([(k, p, v)], OrdPSQ k p v)+atMostView pt = go []+ where+ go acc t@(Winner (E _ p _) _ _)+ | p > pt = (acc, t)+ go acc Void = (acc, Void)+ go acc (Winner (E k p v) Start _) = ((k, p, v) : acc, Void)+ go acc (Winner e (RLoser _ e' tl m tr) m') =+ let (acc', t') = go acc (Winner e tl m)+ (acc'', t'') = go acc' (Winner e' tr m') in+ (acc'', t' `play` t'')+ go acc (Winner e (LLoser _ e' tl m tr) m') =+ let (acc', t') = go acc (Winner e' tl m)+ (acc'', t'') = go acc' (Winner e tr m') in+ (acc'', t' `play` t'') --------------------------------------------------------------------------------
tests/Data/PSQ/Class.hs view
@@ -68,6 +68,8 @@ :: Ord p => Key psq -> psq p v -> Maybe (p, v, psq p v) minView :: Ord p => psq p v -> Maybe (Key psq, p, v, psq p v)+ atMostView+ :: Ord p => p -> psq p v -> ([(Key psq, p, v)], psq p v) -- Traversals map :: Ord p => (Key psq -> p -> v -> w) -> psq p v -> psq p w@@ -99,6 +101,7 @@ insertView = IntPSQ.insertView deleteView = IntPSQ.deleteView minView = IntPSQ.minView+ atMostView = IntPSQ.atMostView map = IntPSQ.map fold' = IntPSQ.fold' valid = IntPSQ.valid@@ -124,6 +127,7 @@ insertView = OrdPSQ.insertView deleteView = OrdPSQ.deleteView minView = OrdPSQ.minView+ atMostView = OrdPSQ.atMostView map = OrdPSQ.map fold' = OrdPSQ.fold' valid = OrdPSQ.valid@@ -149,6 +153,7 @@ insertView = HashPSQ.insertView deleteView = HashPSQ.deleteView minView = HashPSQ.minView+ atMostView = HashPSQ.atMostView map = HashPSQ.map fold' = HashPSQ.fold' valid = HashPSQ.valid
tests/Data/PSQ/Class/Tests.hs view
@@ -73,6 +73,7 @@ , 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@@ -439,3 +440,19 @@ Show (psq Int Char)) => Tagged psq (psq Int Char -> Bool) prop_valid = Tagged valid++prop_atMostView+ :: forall psq. (PSQ psq, Show (Key psq), Show (psq Int Char))+ => Tagged psq (psq Int Char -> Property)+prop_atMostView = Tagged $ \t ->+ forAll arbitraryPriority $ \p ->+ let (elems, t') = atMostView p t in+ -- 1. Test that priorities are at most 'p'.+ and [p' <= p | (_, p', _) <- elems] &&+ -- 2. Test that the remaining priorities are larger than 'p'.+ (case findMin t' of+ Nothing -> True+ Just (_, p', _) -> p' > p) &&+ -- 2. Test that the size of the removed elements and the new queue total+ -- the original size.+ length elems + size t' == size t
tests/Data/PSQ/Class/Util.hs view
@@ -68,7 +68,7 @@ assertErrorCall handler x = handle (\e -> case fromException e of Just (ErrorCall str) -> handler str- Nothing -> assertFailure $+ _ -> assertFailure $ "assertErrorCall: expected `error` but got: " ++ show e) (x `seq` assertFailure "assertErrorCall: evaluated to WHNF and no exception was thrown")