commit ghc-pqueue for openSUSE:Factory
![](https://seccdn.libravatar.org/avatar/e2145bc5cf53dda95c308a3c75e8fef3.jpg?s=120&d=mm&r=g)
Hello community, here is the log from the commit of package ghc-pqueue for openSUSE:Factory checked in at 2017-05-10 20:48:36 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-pqueue (Old) and /work/SRC/openSUSE:Factory/.ghc-pqueue.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-pqueue" Wed May 10 20:48:36 2017 rev:2 rq:489364 version:1.3.2.2 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-pqueue/ghc-pqueue.changes 2017-04-12 18:08:30.427362209 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-pqueue.new/ghc-pqueue.changes 2017-05-10 20:48:37.546863780 +0200 @@ -1,0 +2,5 @@ +Mon Mar 27 12:40:25 UTC 2017 - psimons@suse.com + +- Update to version 1.3.2.2 with cabal2obs. + +------------------------------------------------------------------- Old: ---- pqueue-1.3.2.tar.gz New: ---- pqueue-1.3.2.2.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-pqueue.spec ++++++ --- /var/tmp/diff_new_pack.6V9nn9/_old 2017-05-10 20:48:38.418740752 +0200 +++ /var/tmp/diff_new_pack.6V9nn9/_new 2017-05-10 20:48:38.426739624 +0200 @@ -17,8 +17,9 @@ %global pkg_name pqueue +%bcond_with tests Name: ghc-%{pkg_name} -Version: 1.3.2 +Version: 1.3.2.2 Release: 0 Summary: Reliable, persistent, fast priority queues License: BSD-3-Clause @@ -29,6 +30,9 @@ BuildRequires: ghc-deepseq-devel BuildRequires: ghc-rpm-macros BuildRoot: %{_tmppath}/%{name}-%{version}-build +%if %{with tests} +BuildRequires: ghc-QuickCheck-devel +%endif %description A fast, reliable priority queue implementation based on a binomial heap. @@ -53,6 +57,9 @@ %install %ghc_lib_install +%check +%cabal_test + %post devel %ghc_pkg_recache ++++++ pqueue-1.3.2.tar.gz -> pqueue-1.3.2.2.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pqueue-1.3.2/CHANGELOG.md new/pqueue-1.3.2.2/CHANGELOG.md --- old/pqueue-1.3.2/CHANGELOG.md 2016-09-28 15:44:50.000000000 +0200 +++ new/pqueue-1.3.2.2/CHANGELOG.md 2017-03-12 15:23:47.000000000 +0100 @@ -1,5 +1,15 @@ # Revision history for pqueue +## 1.3.2.2 -- 2017-03-12 + + * Add test-suite from darcs repository for pqueue-1.0.1. + +## 1.3.2.1 -- 2017-03-11 + + * Fix documentation errors + - complexity on `toList`, `toListU` + - PQueue.Prio.Max had "ascending" instead of "descending" in some places + ## 1.3.2 -- 2016-09-28 * Add function `insertBehind` as a slight variation of `insert` which differs diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pqueue-1.3.2/Control/Applicative/Identity.hs new/pqueue-1.3.2.2/Control/Applicative/Identity.hs --- old/pqueue-1.3.2/Control/Applicative/Identity.hs 2016-09-28 15:44:50.000000000 +0200 +++ new/pqueue-1.3.2.2/Control/Applicative/Identity.hs 2017-03-12 15:23:47.000000000 +0100 @@ -2,6 +2,8 @@ import Control.Applicative +import Prelude + newtype Identity a = Identity {runIdentity :: a} instance Functor Identity where @@ -9,4 +11,4 @@ instance Applicative Identity where pure = Identity - Identity f <*> Identity x = Identity (f x) \ No newline at end of file + Identity f <*> Identity x = Identity (f x) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pqueue-1.3.2/Data/PQueue/Internals.hs new/pqueue-1.3.2.2/Data/PQueue/Internals.hs --- old/pqueue-1.3.2/Data/PQueue/Internals.hs 2016-09-28 15:44:50.000000000 +0200 +++ new/pqueue-1.3.2.2/Data/PQueue/Internals.hs 2017-03-12 15:23:47.000000000 +0100 @@ -31,11 +31,11 @@ seqSpine ) where -import Control.DeepSeq +import Control.DeepSeq (NFData(rnf), deepseq) -import Data.Functor +import Data.Functor ((<$>)) import Data.Foldable (Foldable (foldr, foldl)) -import Data.Monoid (Monoid (..)) +import Data.Monoid (mappend) import qualified Data.PQueue.Prio.Internals as Prio #ifdef __GLASGOW_HASKELL__ @@ -58,14 +58,14 @@ gfoldl f z q = case minView q of Nothing -> z Empty Just (x, q') -> z insertMinQ `f` x `f` q' - + gunfold k z c = case constrIndex c of 1 -> z Empty 2 -> k (k (z insertMinQ)) _ -> error "gunfold" - + dataCast1 x = gcast1 x - + toConstr q | null q = emptyConstr | otherwise = consConstr @@ -85,30 +85,33 @@ instance Ord a => Eq (MinQueue a) where Empty == Empty = True - MinQueue n1 x1 q1 == MinQueue n2 x2 q2 = n1 == n2 && x1 == x2 && eq' q1 q2 where - eq' q1 q2 = case (extractHeap q1, extractHeap q2) of - (Just (x1, q1'), Just (x2, q2')) - -> x1 == x2 && eq' q1' q2' - (Nothing, Nothing) - -> True - _ -> False + MinQueue n1 x1 q1 == MinQueue n2 x2 q2 = + n1 == n2 && eqExtract (x1,q1) (x2,q2) _ == _ = False +eqExtract :: Ord a => (a, BinomHeap a) -> (a, BinomHeap a) -> Bool +eqExtract (x1,q1) (x2,q2) = + x1 == x2 && + case (extractHeap q1, extractHeap q2) of + (Just h1, Just h2) -> eqExtract h1 h2 + (Nothing, Nothing) -> True + _ -> False + instance Ord a => Ord (MinQueue a) where Empty `compare` Empty = EQ Empty `compare` _ = LT _ `compare` Empty = GT - MinQueue _n1 x1 q1 `compare` MinQueue _n2 x2 q2 = compare x1 x2 `mappend` cmp' q1 q2 where - cmp' q1 q2 = case (extractHeap q1, extractHeap q2) of - (Just (x1, q1'), Just (x2, q2')) - -> compare x1 x2 `mappend` cmp' q1' q2' - (Nothing, Nothing) - -> EQ - (Just{}, Nothing) - -> GT - (Nothing, Just{}) - -> LT - + MinQueue _n1 x1 q1 `compare` MinQueue _n2 x2 q2 = cmpExtract (x1,q1) (x2,q2) + +cmpExtract :: Ord a => (a, BinomHeap a) -> (a, BinomHeap a) -> Ordering +cmpExtract (x1,q1) (x2,q2) = + compare x1 x2 `mappend` + case (extractHeap q1, extractHeap q2) of + (Just h1, Just h2) -> cmpExtract h1 h2 + (Nothing, Nothing) -> EQ + (Just _, Nothing) -> GT + (Nothing, Just _) -> LT + -- We compare their first elements, then their other elements up to the smaller queue's length, -- and then the longer queue wins. -- This is equivalent to @comparing toAscList@, except it fuses much more nicely. @@ -116,31 +119,31 @@ -- We implement tree ranks in the type system with a nicely elegant approach, as follows. -- The goal is to have the type system automatically guarantee that our binomial forest -- has the correct binomial structure. --- +-- -- In the traditional set-theoretic construction of the natural numbers, we define -- each number to be the set of numbers less than it, and Zero to be the empty set, -- as follows: --- +-- -- 0 = {} 1 = {0} 2 = {0, 1} 3={0, 1, 2} ... --- +-- -- Binomial trees have a similar structure: a tree of rank @k@ has one child of each -- rank less than @k@. Let's define the type @rk@ corresponding to rank @k@ to refer -- to a collection of binomial trees of ranks @0..k-1@. Then we can say that --- +-- -- > data Succ rk a = Succ (BinomTree rk a) (rk a) --- +-- -- and this behaves exactly as the successor operator for ranks should behave. Furthermore, -- we immediately obtain that --- +-- -- > data BinomTree rk a = BinomTree a (rk a) --- +-- -- which is nice and compact. With this construction, things work out extremely nicely: --- +-- -- > BinomTree (Succ (Succ (Succ Zero))) --- +-- -- is a type constructor that takes an element type and returns the type of binomial trees -- of rank @3@. -data BinomForest rk a = Nil | Skip (BinomForest (Succ rk) a) | +data BinomForest rk a = Nil | Skip (BinomForest (Succ rk) a) | Cons {-# UNPACK #-} !(BinomTree rk a) (BinomForest (Succ rk) a) data BinomTree rk a = BinomTree a (rk a) @@ -175,7 +178,7 @@ getMin (MinQueue _ x _) = Just x getMin _ = Nothing --- | Retrieves the minimum element of the queue, and the queue stripped of that element, +-- | Retrieves the minimum element of the queue, and the queue stripped of that element, -- or 'Nothing' if passed an empty queue. minView :: Ord a => MinQueue a -> Maybe (a, MinQueue a) minView Empty = Nothing @@ -187,7 +190,7 @@ singleton :: a -> MinQueue a singleton x = MinQueue 1 x Nil --- | Amortized /O(1)/, worst-case /O(log n)/. Insert an element into the priority queue. +-- | Amortized /O(1)/, worst-case /O(log n)/. Insert an element into the priority queue. insert :: Ord a => a -> MinQueue a -> MinQueue a insert = insert' (<=) @@ -241,24 +244,24 @@ {-# INLINE foldlUnfold #-} -- | @foldlUnfold f z suc s0@ is equivalent to @foldl f z (unfoldr suc s0)@. foldlUnfold :: (c -> a -> c) -> c -> (b -> Maybe (a, b)) -> b -> c -foldlUnfold f z suc s0 = unf z s0 where +foldlUnfold f z0 suc s0 = unf z0 s0 where unf z s = case suc s of Nothing -> z Just (x, s') -> unf (z `f` x) s' insert' :: LEq a -> a -> MinQueue a -> MinQueue a insert' _ x Empty = singleton x -insert' (<=) x (MinQueue n x' ts) - | x <= x' = MinQueue (n+1) x (incr (<=) (tip x') ts) - | otherwise = MinQueue (n+1) x' (incr (<=) (tip x) ts) +insert' le x (MinQueue n x' ts) + | x `le` x' = MinQueue (n+1) x (incr le (tip x') ts) + | otherwise = MinQueue (n+1) x' (incr le (tip x) ts) {-# INLINE union' #-} union' :: LEq a -> MinQueue a -> MinQueue a -> MinQueue a union' _ Empty q = q union' _ q Empty = q -union' (<=) (MinQueue n1 x1 f1) (MinQueue n2 x2 f2) - | x1 <= x2 = MinQueue (n1 + n2) x1 (carry (<=) (tip x2) f1 f2) - | otherwise = MinQueue (n1 + n2) x2 (carry (<=) (tip x1) f1 f2) +union' le (MinQueue n1 x1 f1) (MinQueue n2 x2 f2) + | x1 `le` x2 = MinQueue (n1 + n2) x1 (carry le (tip x2) f1 f2) + | otherwise = MinQueue (n1 + n2) x2 (carry le (tip x1) f1 f2) -- | Takes a size and a binomial forest and produces a priority queue with a distinguished global root. extractHeap :: Ord a => BinomHeap a -> Maybe (a, BinomHeap a) @@ -268,25 +271,25 @@ -- | A specialized type intended to organize the return of extract-min queries -- from a binomial forest. We walk all the way through the forest, and then --- walk backwards. @Extract rk a@ is the result type of an extract-min +-- walk backwards. @Extract rk a@ is the result type of an extract-min -- operation that has walked as far backwards of rank @rk@ -- that is, it -- has visited every root of rank @>= rk@. --- +-- -- The interpretation of @Extract minKey children forest@ is --- +-- -- * @minKey@ is the key of the minimum root visited so far. It may have --- any rank @>= rk@. We will denote the root corresponding to +-- any rank @>= rk@. We will denote the root corresponding to -- @minKey@ as @minRoot@. --- --- * @children@ is those children of @minRoot@ which have not yet been --- merged with the rest of the forest. Specifically, these are +-- +-- * @children@ is those children of @minRoot@ which have not yet been +-- merged with the rest of the forest. Specifically, these are -- the children with rank @< rk@. --- --- * @forest@ is an accumulating parameter that maintains the partial --- reconstruction of the binomial forest without @minRoot@. It is --- the union of all old roots with rank @>= rk@ (except @minRoot@), --- with the set of all children of @minRoot@ with rank @>= rk@. --- Note that @forest@ is lazy, so if we discover a smaller key +-- +-- * @forest@ is an accumulating parameter that maintains the partial +-- reconstruction of the binomial forest without @minRoot@. It is +-- the union of all old roots with rank @>= rk@ (except @minRoot@), +-- with the set of all children of @minRoot@ with rank @>= rk@. +-- Note that @forest@ is lazy, so if we discover a smaller key -- than @minKey@ later, we haven't wasted significant work. data Extract rk a = Extract a (rk a) (BinomForest rk a) data MExtract rk a = No | Yes {-# UNPACK #-} !(Extract rk a) @@ -296,47 +299,47 @@ = Extract minKey kChildren (Cons kChild ts) incrExtract' :: LEq a -> BinomTree rk a -> Extract (Succ rk) a -> Extract rk a -incrExtract' (<=) t (Extract minKey (Succ kChild kChildren) ts) - = Extract minKey kChildren (Skip (incr (<=) (t `cat` kChild) ts)) +incrExtract' le t (Extract minKey (Succ kChild kChildren) ts) + = Extract minKey kChildren (Skip (incr le (t `cat` kChild) ts)) where - cat = joinBin (<=) + cat = joinBin le -- | Walks backward from the biggest key in the forest, as far as rank @rk@. -- Returns its progress. Each successive application of @extractBin@ takes -- amortized /O(1)/ time, so applying it from the beginning takes /O(log n)/ time. extractBin :: LEq a -> BinomForest rk a -> MExtract rk a extractBin _ Nil = No -extractBin (<=) (Skip f) = case extractBin (<=) f of +extractBin le (Skip f) = case extractBin le f of Yes ex -> Yes (incrExtract ex) No -> No -extractBin (<=) (Cons t@(BinomTree x ts) f) = Yes $ case extractBin (<=) f of +extractBin le (Cons t@(BinomTree x ts) f) = Yes $ case extractBin le f of Yes ex@(Extract minKey _ _) - | minKey < x -> incrExtract' (<=) t ex - _ -> Extract x ts (Skip f) - where a < b = not (b <= a) + | minKey `lt` x -> incrExtract' le t ex + _ -> Extract x ts (Skip f) + where a `lt` b = not (b `le` a) mapMaybeQueue :: (a -> Maybe b) -> LEq b -> (rk a -> MinQueue b) -> MinQueue b -> BinomForest rk a -> MinQueue b -mapMaybeQueue f (<=) fCh q0 forest = q0 `seq` case forest of +mapMaybeQueue f le fCh q0 forest = q0 `seq` case forest of Nil -> q0 - Skip forest' -> mapMaybeQueue f (<=) fCh' q0 forest' - Cons t forest' -> mapMaybeQueue f (<=) fCh' (union' (<=) (mapMaybeT t) q0) forest' - where fCh' (Succ t tss) = union' (<=) (mapMaybeT t) (fCh tss) - mapMaybeT (BinomTree x ts) = maybe (fCh ts) (\ x -> insert' (<=) x (fCh ts)) (f x) + Skip forest' -> mapMaybeQueue f le fCh' q0 forest' + Cons t forest' -> mapMaybeQueue f le fCh' (union' le (mapMaybeT t) q0) forest' + where fCh' (Succ t tss) = union' le (mapMaybeT t) (fCh tss) + mapMaybeT (BinomTree x0 ts) = maybe (fCh ts) (\ x -> insert' le x (fCh ts)) (f x0) type Partition a b = (MinQueue a, MinQueue b) mapEitherQueue :: (a -> Either b c) -> LEq b -> LEq c -> (rk a -> Partition b c) -> Partition b c -> BinomForest rk a -> Partition b c -mapEitherQueue f (<=) (<=.) fCh (q0, q1) ts = q0 `seq` q1 `seq` case ts of - Nil -> (q0, q1) - Skip ts' -> mapEitherQueue f (<=) (<=.) fCh' (q0, q1) ts' - Cons t ts' -> mapEitherQueue f (<=) (<=.) fCh' (both (union' (<=)) (union' (<=.)) (partitionT t) (q0, q1)) ts' +mapEitherQueue f0 leB leC fCh (q00, q10) ts0 = q00 `seq` q10 `seq` case ts0 of + Nil -> (q00, q10) + Skip ts' -> mapEitherQueue f0 leB leC fCh' (q00, q10) ts' + Cons t ts' -> mapEitherQueue f0 leB leC fCh' (both (union' leB) (union' leC) (partitionT t) (q00, q10)) ts' where both f g (x1, x2) (y1, y2) = (f x1 y1, g x2 y2) - fCh' (Succ t tss) = both (union' (<=)) (union' (<=.)) (partitionT t) (fCh tss) + fCh' (Succ t tss) = both (union' leB) (union' leC) (partitionT t) (fCh tss) partitionT (BinomTree x ts) = case fCh ts of - (q0, q1) -> case f x of - Left b -> (insert' (<=) b q0, q1) - Right c -> (q0, insert' (<=.) c q1) + (q0, q1) -> case f0 x of + Left b -> (insert' leB b q0, q1) + Right c -> (q0, insert' leC c q1) {-# INLINE tip #-} -- | Constructs a binomial tree of rank 0. @@ -358,46 +361,46 @@ -- Each successive application of this function costs /O(1)/, so applying it -- from the beginning costs /O(log n)/. merge :: LEq a -> BinomForest rk a -> BinomForest rk a -> BinomForest rk a -merge (<=) f1 f2 = case (f1, f2) of - (Skip f1', Skip f2') -> Skip (merge (<=) f1' f2') - (Skip f1', Cons t2 f2') -> Cons t2 (merge (<=) f1' f2') - (Cons t1 f1', Skip f2') -> Cons t1 (merge (<=) f1' f2') +merge le f1 f2 = case (f1, f2) of + (Skip f1', Skip f2') -> Skip (merge le f1' f2') + (Skip f1', Cons t2 f2') -> Cons t2 (merge le f1' f2') + (Cons t1 f1', Skip f2') -> Cons t1 (merge le f1' f2') (Cons t1 f1', Cons t2 f2') - -> Skip (carry (<=) (t1 `cat` t2) f1' f2') + -> Skip (carry le (t1 `cat` t2) f1' f2') (Nil, _) -> f2 (_, Nil) -> f1 - where cat = joinBin (<=) + where cat = joinBin le --- | Merges two binomial forests with another tree. If we are thinking of the trees +-- | Merges two binomial forests with another tree. If we are thinking of the trees -- in the binomial forest as binary digits, this corresponds to a carry operation. -- Each call to this function takes /O(1)/ time, so in total, it costs /O(log n)/. carry :: LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a -> BinomForest rk a -carry (<=) t0 f1 f2 = t0 `seq` case (f1, f2) of - (Skip f1', Skip f2') -> Cons t0 (merge (<=) f1' f2') +carry le t0 f1 f2 = t0 `seq` case (f1, f2) of + (Skip f1', Skip f2') -> Cons t0 (merge le f1' f2') (Skip f1', Cons t2 f2') -> Skip (mergeCarry t0 t2 f1' f2') (Cons t1 f1', Skip f2') -> Skip (mergeCarry t0 t1 f1' f2') (Cons t1 f1', Cons t2 f2') -> Cons t0 (mergeCarry t1 t2 f1' f2') - (Nil, _f2) -> incr (<=) t0 f2 - (_f1, Nil) -> incr (<=) t0 f1 - where cat = joinBin (<=) - mergeCarry tA tB = carry (<=) (tA `cat` tB) + (Nil, _f2) -> incr le t0 f2 + (_f1, Nil) -> incr le t0 f1 + where cat = joinBin le + mergeCarry tA tB = carry le (tA `cat` tB) -- | Merges a binomial tree into a binomial forest. If we are thinking -- of the trees in the binomial forest as binary digits, this corresponds -- to adding a power of 2. This costs amortized /O(1)/ time. incr :: LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a -incr (<=) t f = t `seq` case f of +incr le t f0 = t `seq` case f0 of Nil -> Cons t Nil Skip f -> Cons t f - Cons t' f' -> Skip (incr (<=) (t `cat` t') f') - where cat = joinBin (<=) + Cons t' f' -> Skip (incr le (t `cat` t') f') + where cat = joinBin le -- | The carrying operation: takes two binomial heaps of the same rank @k@ -- and returns one of rank @k+1@. Takes /O(1)/ time. joinBin :: LEq a -> BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a -joinBin (<=) t1@(BinomTree x1 ts1) t2@(BinomTree x2 ts2) - | x1 <= x2 = BinomTree x1 (Succ t2 ts1) +joinBin le t1@(BinomTree x1 ts1) t2@(BinomTree x2 ts2) + | x1 `le` x2 = BinomTree x1 (Succ t2 ts1) | otherwise = BinomTree x2 (Succ t1 ts2) instance Functor Zero where @@ -436,13 +439,13 @@ -- instance Traversable Zero where -- traverse _ _ = pure Zero --- +-- -- instance Traversable rk => Traversable (Succ rk) where -- traverse f (Succ t ts) = Succ <$> traverse f t <*> traverse f ts --- +-- -- instance Traversable rk => Traversable (BinomTree rk) where -- traverse f (BinomTree x ts) = BinomTree <$> f x <*> traverse f ts --- +-- -- instance Traversable rk => Traversable (BinomForest rk) where -- traverse _ Nil = pure Nil -- traverse f (Skip tss) = Skip <$> traverse f tss @@ -482,7 +485,7 @@ keysQueue (Prio.MinPQ n k _ ts) = MinQueue n k (keysF (const Zero) ts) keysF :: (pRk k a -> rk k) -> Prio.BinomForest pRk k a -> BinomForest rk k -keysF f ts = case ts of +keysF f ts0 = case ts0 of Prio.Nil -> Nil Prio.Skip ts' -> Skip (keysF f' ts') Prio.Cons (Prio.BinomTree k _ ts) ts' diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pqueue-1.3.2/Data/PQueue/Max.hs new/pqueue-1.3.2.2/Data/PQueue/Max.hs --- old/pqueue-1.3.2/Data/PQueue/Max.hs 2016-09-28 15:44:50.000000000 +0200 +++ new/pqueue-1.3.2.2/Data/PQueue/Max.hs 2017-03-12 15:23:47.000000000 +0100 @@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | --- Module : Data.PQueue.Min +-- Module : Data.PQueue.Max -- Copyright : (c) Louis Wasserman 2010 -- License : BSD-style -- Maintainer : libraries@haskell.org @@ -20,7 +20,7 @@ -- use 'seqSpine'. -- -- This implementation does not guarantee stable behavior. --- +-- -- This implementation offers a number of methods of the form @xxxU@, where @U@ stands for -- unordered. No guarantees whatsoever are made on the execution or traversal order of -- these functions. @@ -30,7 +30,7 @@ -- * Basic operations empty, null, - size, + size, -- * Query operations findMax, getMax, @@ -83,13 +83,12 @@ keysQueue, seqSpine) where -import Control.Applicative (Applicative(..), (<$>)) -import Control.DeepSeq +import Control.DeepSeq (NFData(rnf)) -import Data.Monoid -import Data.Maybe hiding (mapMaybe) +import Data.Functor ((<$>)) +import Data.Monoid (Monoid(mempty, mappend)) +import Data.Maybe (fromMaybe) import Data.Foldable (foldl, foldr) -import Data.Traversable import qualified Data.PQueue.Min as Min import qualified Data.PQueue.Prio.Max.Internals as Prio @@ -107,7 +106,7 @@ build f = f (:) [] #endif --- | A priority queue with elements of type @a@. Supports extracting the maximum element. +-- | A priority queue with elements of type @a@. Supports extracting the maximum element. -- Implemented as a wrapper around 'Min.MinQueue'. newtype MaxQueue a = MaxQ (Min.MinQueue (Down a)) # if __GLASGOW_HASKELL__ @@ -122,7 +121,7 @@ instance (Ord a, Show a) => Show (MaxQueue a) where showsPrec p xs = showParen (p > 10) $ showString "fromDescList " . shows (toDescList xs) - + instance Read a => Read (MaxQueue a) where #ifdef __GLASGOW_HASKELL__ readPrec = parens $ prec 10 $ do @@ -176,7 +175,7 @@ Nothing -> Nothing Just (Down x, q') -> Just (x, MaxQ q') - + -- | /O(log n)/. Delete the top (maximum) element of the sequence, if there is one. delete :: Ord a => MaxQueue a -> Maybe (MaxQueue a) delete = fmap snd . maxView @@ -185,7 +184,7 @@ singleton :: a -> MaxQueue a singleton = MaxQ . Min.singleton . Down --- | /O(1)/. Insert an element into the priority queue. +-- | /O(1)/. Insert an element into the priority queue. insert :: Ord a => a -> MaxQueue a -> MaxQueue a x `insert` MaxQ q = MaxQ (Down x `Min.insert` q) @@ -220,7 +219,7 @@ splitAt :: Ord a => Int -> MaxQueue a -> ([a], MaxQueue a) splitAt k (MaxQ q) = (map unDown xs, MaxQ q') where (xs, q') = Min.splitAt k q - + -- | 'takeWhile', applied to a predicate @p@ and a queue @queue@, returns the -- longest prefix (possibly empty) of @queue@ of elements that satisfy @p@. takeWhile :: Ord a => (a -> Bool) -> MaxQueue a -> [a] @@ -233,7 +232,7 @@ -- | 'span', applied to a predicate @p@ and a queue @queue@, returns a tuple where -- first element is longest prefix (possibly empty) of @queue@ of elements that -- satisfy @p@ and second element is the remainder of the queue. --- +-- span :: Ord a => (a -> Bool) -> MaxQueue a -> ([a], MaxQueue a) span p (MaxQ q) = (map unDown xs, MaxQ q') where (xs, q') = Min.span (p . unDown) q @@ -308,19 +307,23 @@ -- | /O(n log n)/. Extracts the elements of the priority queue in ascending order. toAscList :: Ord a => MaxQueue a -> [a] toAscList q = build (\ c nil -> foldrAsc c nil q) +-- I can see no particular reason this does not simply forward to Min.toDescList. (lsp, 2016) {-# INLINE toDescList #-} -- | /O(n log n)/. Extracts the elements of the priority queue in descending order. toDescList :: Ord a => MaxQueue a -> [a] toDescList q = build (\ c nil -> foldrDesc c nil q) +-- I can see no particular reason this does not simply forward to Min.toAscList. (lsp, 2016) {-# INLINE toList #-} --- | /O(n)/. Returns the elements of the priority queue in no particular order. +-- | /O(n log n)/. Returns the elements of the priority queue in ascending order. Equivalent to 'toDescList'. +-- +-- If the order of the elements is irrelevant, consider using 'toListU'. toList :: Ord a => MaxQueue a -> [a] toList (MaxQ q) = map unDown (Min.toList q) {-# INLINE fromAscList #-} --- | /O(n)/. Constructs a priority queue from an ascending list. /Warning/: Does not check the precondition. +-- | /O(n)/. Constructs a priority queue from an ascending list. /Warning/: Does not check the precondition. fromAscList :: [a] -> MaxQueue a fromAscList = MaxQ . Min.fromDescList . map Down diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pqueue-1.3.2/Data/PQueue/Min.hs new/pqueue-1.3.2.2/Data/PQueue/Min.hs --- old/pqueue-1.3.2/Data/PQueue/Min.hs 2016-09-28 15:44:50.000000000 +0200 +++ new/pqueue-1.3.2.2/Data/PQueue/Min.hs 2017-03-12 15:23:47.000000000 +0100 @@ -21,7 +21,7 @@ -- use 'seqSpine'. -- -- This implementation does not guarantee stable behavior. --- +-- -- This implementation offers a number of methods of the form @xxxU@, where @U@ stands for -- unordered. No guarantees whatsoever are made on the execution or traversal order of -- these functions. @@ -31,7 +31,7 @@ -- * Basic operations empty, null, - size, + size, -- * Query operations findMin, getMin, @@ -85,13 +85,9 @@ import Prelude hiding (null, foldr, foldl, take, drop, takeWhile, dropWhile, splitAt, span, break, (!!), filter, map) -import Control.Applicative (Applicative(..), (<$>)) -import Control.Applicative.Identity - -import Data.Monoid -import Data.Maybe hiding (mapMaybe) +import Data.Monoid (Monoid(mempty, mappend, mconcat)) import Data.Foldable (foldl, foldr, foldl') -import Data.Traversable +import Data.Maybe (fromMaybe) import qualified Data.List as List @@ -101,13 +97,12 @@ import GHC.Exts (build) import Text.Read (Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec, readListPrecDefault) -import Data.Data #else build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a] build f = f (:) [] #endif --- instance +-- instance instance (Ord a, Show a) => Show (MinQueue a) where showsPrec p xs = showParen (p > 10) $ @@ -151,7 +146,7 @@ unions :: Ord a => [MinQueue a] -> MinQueue a unions = foldl union empty --- | /O(k log n)/. Index (subscript) operator, starting from 0. @queue !! k@ returns the @(k+1)@th smallest +-- | /O(k log n)/. Index (subscript) operator, starting from 0. @queue !! k@ returns the @(k+1)@th smallest -- element in the queue. Equivalent to @toAscList queue !! k@. (!!) :: Ord a => MinQueue a -> Int -> a q !! n | n >= size q @@ -167,11 +162,11 @@ {-# INLINE foldWhileFB #-} -- | Equivalent to Data.List.takeWhile, but is a better producer. foldWhileFB :: (a -> Bool) -> [a] -> [a] -foldWhileFB p xs = build (\ c nil -> let +foldWhileFB p xs0 = build (\ c nil -> let consWhile x xs | p x = x `c` xs | otherwise = nil - in foldr consWhile nil xs) + in foldr consWhile nil xs0) -- | 'dropWhile' @p queue@ returns the queue remaining after 'takeWhile' @p queue@. dropWhile :: Ord a => (a -> Bool) -> MinQueue a -> MinQueue a @@ -185,7 +180,7 @@ -- satisfy @p@ and second element is the remainder of the queue. span :: Ord a => (a -> Bool) -> MinQueue a -> ([a], MinQueue a) span p queue = case minView queue of - Just (x, q') + Just (x, q') | p x -> let (ys, q'') = span p q' in (x:ys, q'') _ -> ([], queue) @@ -241,8 +236,8 @@ toDescList queue = build (\ c nil -> foldrDesc c nil queue) {-# INLINE toList #-} --- | /O(n)/. Returns the elements of the priority queue in ascending order. Equivalent to 'toAscList'. --- +-- | /O(n log n)/. Returns the elements of the priority queue in ascending order. Equivalent to 'toAscList'. +-- -- If the order of the elements is irrelevant, consider using 'toListU'. toList :: Ord a => MinQueue a -> [a] toList = toAscList @@ -292,7 +287,7 @@ elemsU :: MinQueue a -> [a] elemsU = toListU --- | Returns the elements of the queue, in no particular order. +-- | /O(n)/. Returns the elements of the queue, in no particular order. toListU :: MinQueue a -> [a] toListU q = build (\ c n -> foldrU c n q) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pqueue-1.3.2/Data/PQueue/Prio/Internals.hs new/pqueue-1.3.2.2/Data/PQueue/Prio/Internals.hs --- old/pqueue-1.3.2/Data/PQueue/Prio/Internals.hs 2016-09-28 15:44:50.000000000 +0200 +++ new/pqueue-1.3.2.2/Data/PQueue/Prio/Internals.hs 2017-03-12 15:23:47.000000000 +0100 @@ -33,10 +33,11 @@ ) where import Control.Applicative (Applicative(..), (<$>)) -import Control.Applicative.Identity -import Control.DeepSeq +import Control.Applicative.Identity (Identity(Identity, runIdentity)) +import Control.DeepSeq (NFData(rnf), deepseq) import Data.Monoid (Monoid (..)) + import Prelude hiding (null) #if __GLASGOW_HASKELL__ @@ -73,7 +74,7 @@ deriving (Typeable) #endif -data BinomForest rk k a = +data BinomForest rk k a = Nil | Skip (BinomForest (Succ rk) k a) | Cons {-# UNPACK #-} !(BinomTree rk k a) (BinomForest (Succ rk) k a) @@ -87,36 +88,48 @@ instance (Ord k, Eq a) => Eq (MinPQueue k a) where MinPQ n1 k1 a1 ts1 == MinPQ n2 k2 a2 ts2 = - n1 == n2 && k1 == k2 && a1 == a2 && equHeap ts1 ts2 - where - equHeap ts1 ts2 = case (extract ts1, extract ts2) of - (Yes (Extract k1 a1 _ ts1'), Yes (Extract k2 a2 _ ts2')) - -> k1 == k2 && a1 == a2 && equHeap ts1' ts2' - (No, No) -> True - _ -> False - extract = extractForest (<=) + n1 == n2 && eqExtract k1 a1 ts1 k2 a2 ts2 Empty == Empty = True _ == _ = False +eqExtract :: + (Ord k, Eq a) => + k -> a -> BinomForest rk k a -> + k -> a -> BinomForest rk k a -> + Bool +eqExtract k10 a10 ts10 k20 a20 ts20 = + k10 == k20 && a10 == a20 && + case (extract ts10, extract ts20) of + (Yes (Extract k1 a1 _ ts1'), Yes (Extract k2 a2 _ ts2')) + -> eqExtract k1 a1 ts1' k2 a2 ts2' + (No, No) -> True + _ -> False + (<>) :: Monoid m => m -> m -> m (<>) = mappend infixr 6 <> instance (Ord k, Ord a) => Ord (MinPQueue k a) where - MinPQ _n1 k1 a1 ts1 `compare` MinPQ _n2 k2 a2 ts2 = - k1 `compare` k2 <> a1 `compare` a2 <> ts1 `cmpHeap` ts2 - where - ts1 `cmpHeap` ts2 = case (extract ts1, extract ts2) of - (Yes (Extract k1 a1 _ ts1'), Yes (Extract k2 a2 _ ts2')) - -> k1 `compare` k2 <> a1 `compare` a2 <> ts1' `cmpHeap` ts2' - (No, Yes{}) -> LT - (Yes{}, No) -> GT - (No, No) -> EQ - extract = extractForest (<=) + MinPQ _n1 k10 a10 ts10 `compare` MinPQ _n2 k20 a20 ts20 = + cmpExtract k10 a10 ts10 k20 a20 ts20 Empty `compare` Empty = EQ Empty `compare` MinPQ{} = LT MinPQ{} `compare` Empty = GT +cmpExtract :: + (Ord k, Ord a) => + k -> a -> BinomForest rk k a -> + k -> a -> BinomForest rk k a -> + Ordering +cmpExtract k10 a10 ts10 k20 a20 ts20 = + k10 `compare` k20 <> a10 `compare` a20 <> + case (extract ts10, extract ts20) of + (Yes (Extract k1 a1 _ ts1'), Yes (Extract k2 a2 _ ts2')) + -> cmpExtract k1 a1 ts1' k2 a2 ts2' + (No, Yes{}) -> LT + (Yes{}, No) -> GT + (No, No) -> EQ + -- | /O(1)/. Returns the empty priority queue. empty :: MinPQueue k a empty = Empty @@ -140,7 +153,7 @@ insert :: Ord k => k -> a -> MinPQueue k a -> MinPQueue k a insert = insert' (<=) --- | Amortized /O(1)/, worst-case /O(log n)/. Insert an element +-- | Amortized /O(1)/, worst-case /O(log n)/. Insert an element -- with the specified key into the priority queue, -- putting it behind elements whos key compares equal to the -- inserted one. @@ -150,9 +163,9 @@ -- | Internal helper method, using a specific comparator function. insert' :: CompF k -> k -> a -> MinPQueue k a -> MinPQueue k a insert' _ k a Empty = singleton k a -insert' (<=) k a (MinPQ n k' a' ts) - | k <= k' = MinPQ (n+1) k a (incr (<=) (tip k' a') ts) - | otherwise = MinPQ (n+1) k' a' (incr (<=) (tip k a ) ts) +insert' le k a (MinPQ n k' a' ts) + | k `le` k' = MinPQ (n+1) k a (incr le (tip k' a') ts) + | otherwise = MinPQ (n+1) k' a' (incr le (tip k a ) ts) -- | Amortized /O(log(min(n1, n2)))/, worst-case /O(log(max(n1, n2)))/. Returns the union -- of the two specified queues. @@ -161,10 +174,10 @@ -- | Takes the union of the two specified queues, using the given comparison function. union' :: CompF k -> MinPQueue k a -> MinPQueue k a -> MinPQueue k a -union' (<=) (MinPQ n1 k1 a1 ts1) (MinPQ n2 k2 a2 ts2) - | k1 <= k2 = MinPQ (n1 + n2) k1 a1 (insMerge k2 a2) +union' le (MinPQ n1 k1 a1 ts1) (MinPQ n2 k2 a2 ts2) + | k1 `le` k2 = MinPQ (n1 + n2) k1 a1 (insMerge k2 a2) | otherwise = MinPQ (n1 + n2) k2 a2 (insMerge k1 a1) - where insMerge k a = carryForest (<=) (tip k a) ts1 ts2 + where insMerge k a = carryForest le (tip k a) ts1 ts2 union' _ Empty q2 = q2 union' _ q1 Empty = q1 @@ -211,29 +224,27 @@ -- | /O(n)/. Map values and separate the 'Left' and 'Right' results. mapEitherWithKey :: Ord k => (k -> a -> Either b c) -> MinPQueue k a -> (MinPQueue k b, MinPQueue k c) mapEitherWithKey _ Empty = (Empty, Empty) -mapEitherWithKey f (MinPQ _ k a ts) = either (first' . insert k) (second' . insert k) (f k a) +mapEitherWithKey f (MinPQ _ k a ts) = either (first' . insert k) (second' . insert k) (f k a) (mapEitherF (<=) f (const (Empty, Empty)) ts) --- | /O(n log n)/. Fold the keys and values in the map, such that +-- | /O(n log n)/. Fold the keys and values in the map, such that -- @'foldrWithKey' f z q == 'List.foldr' ('uncurry' f) z ('toAscList' q)@. --- +-- -- If you do not care about the traversal order, consider using 'foldrWithKeyU'. foldrWithKey :: Ord k => (k -> a -> b -> b) -> b -> MinPQueue k a -> b foldrWithKey _ z Empty = z -foldrWithKey f z (MinPQ _ k a ts) = f k a (foldF ts) where - extract = extractForest (<=) +foldrWithKey f z (MinPQ _ k0 a0 ts0) = f k0 a0 (foldF ts0) where foldF ts = case extract ts of Yes (Extract k a _ ts') -> f k a (foldF ts') _ -> z --- | /O(n log n)/. Fold the keys and values in the map, such that +-- | /O(n log n)/. Fold the keys and values in the map, such that -- @'foldlWithKey' f z q == 'List.foldl' ('uncurry' . f) z ('toAscList' q)@. --- +-- -- If you do not care about the traversal order, consider using 'foldlWithKeyU'. foldlWithKey :: Ord k => (b -> k -> a -> b) -> b -> MinPQueue k a -> b foldlWithKey _ z Empty = z -foldlWithKey f z (MinPQ _ k a ts) = foldF (f z k a) ts where - extract = extractForest (<=) +foldlWithKey f z0 (MinPQ _ k0 a0 ts0) = foldF (f z0 k0 a0) ts0 where foldF z ts = case extract ts of Yes (Extract k a _ ts') -> foldF (f z k a) ts' _ -> z @@ -251,38 +262,38 @@ -- | /O(1)/. Takes the union of two binomial trees of the same rank. meld :: CompF k -> BinomTree rk k a -> BinomTree rk k a -> BinomTree (Succ rk) k a -meld (<=) t1@(BinomTree k1 v1 ts1) t2@(BinomTree k2 v2 ts2) - | k1 <= k2 = BinomTree k1 v1 (Succ t2 ts1) +meld le t1@(BinomTree k1 v1 ts1) t2@(BinomTree k2 v2 ts2) + | k1 `le` k2 = BinomTree k1 v1 (Succ t2 ts1) | otherwise = BinomTree k2 v2 (Succ t1 ts2) -- | Takes the union of two binomial forests, starting at the same rank. Analogous to binary addition. mergeForest :: CompF k -> BinomForest rk k a -> BinomForest rk k a -> BinomForest rk k a -mergeForest (<=) f1 f2 = case (f1, f2) of - (Skip ts1, Skip ts2) -> Skip (mergeForest (<=) ts1 ts2) - (Skip ts1, Cons t2 ts2) -> Cons t2 (mergeForest (<=) ts1 ts2) - (Cons t1 ts1, Skip ts2) -> Cons t1 (mergeForest (<=) ts1 ts2) - (Cons t1 ts1, Cons t2 ts2) -> Skip (carryForest (<=) (meld (<=) t1 t2) ts1 ts2) +mergeForest le f1 f2 = case (f1, f2) of + (Skip ts1, Skip ts2) -> Skip (mergeForest le ts1 ts2) + (Skip ts1, Cons t2 ts2) -> Cons t2 (mergeForest le ts1 ts2) + (Cons t1 ts1, Skip ts2) -> Cons t1 (mergeForest le ts1 ts2) + (Cons t1 ts1, Cons t2 ts2) -> Skip (carryForest le (meld le t1 t2) ts1 ts2) (Nil, _) -> f2 (_, Nil) -> f1 --- | Takes the union of two binomial forests, starting at the same rank, with an additional tree. +-- | Takes the union of two binomial forests, starting at the same rank, with an additional tree. -- Analogous to binary addition when a digit has been carried. carryForest :: CompF k -> BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a -> BinomForest rk k a -carryForest (<=) t0 f1 f2 = t0 `seq` case (f1, f2) of +carryForest le t0 f1 f2 = t0 `seq` case (f1, f2) of (Cons t1 ts1, Cons t2 ts2) -> Cons t0 (carryMeld t1 t2 ts1 ts2) (Cons t1 ts1, Skip ts2) -> Skip (carryMeld t0 t1 ts1 ts2) (Skip ts1, Cons t2 ts2) -> Skip (carryMeld t0 t2 ts1 ts2) - (Skip ts1, Skip ts2) -> Cons t0 (mergeForest (<=) ts1 ts2) - (Nil, _) -> incr (<=) t0 f2 - (_, Nil) -> incr (<=) t0 f1 - where carryMeld = carryForest (<=) .: meld (<=) + (Skip ts1, Skip ts2) -> Cons t0 (mergeForest le ts1 ts2) + (Nil, _) -> incr le t0 f2 + (_, Nil) -> incr le t0 f1 + where carryMeld = carryForest le .: meld le -- | Inserts a binomial tree into a binomial forest. Analogous to binary incrementation. incr :: CompF k -> BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a -incr (<=) t ts = t `seq` case ts of +incr le t ts = t `seq` case ts of Nil -> Cons t Nil Skip ts' -> Cons t ts' - Cons t' ts' -> Skip (incr (<=) (meld (<=) t t') ts') + Cons t' ts' -> Skip (incr le (meld le t t') ts') -- | Inserts a binomial tree into a binomial forest. Assumes that the root of this tree -- is less than all other roots. Analogous to binary incrementation. Equivalent to @@ -294,33 +305,33 @@ Cons t' tss' -> Skip (incrMin (BinomTree k a (Succ t' ts)) tss') extractHeap :: CompF k -> Int -> BinomHeap k a -> MinPQueue k a -extractHeap (<=) n ts = n `seq` case extractForest (<=) ts of +extractHeap le n ts = n `seq` case extractForest le ts of No -> Empty Yes (Extract k a _ ts') -> MinPQ (n-1) k a ts' -- | A specialized type intended to organize the return of extract-min queries -- from a binomial forest. We walk all the way through the forest, and then --- walk backwards. @Extract rk a@ is the result type of an extract-min +-- walk backwards. @Extract rk a@ is the result type of an extract-min -- operation that has walked as far backwards of rank @rk@ -- that is, it -- has visited every root of rank @>= rk@. --- +-- -- The interpretation of @Extract minKey minVal children forest@ is --- +-- -- * @minKey@ is the key of the minimum root visited so far. It may have --- any rank @>= rk@. We will denote the root corresponding to +-- any rank @>= rk@. We will denote the root corresponding to -- @minKey@ as @minRoot@. --- +-- -- * @minVal@ is the value corresponding to @minKey@. --- --- * @children@ is those children of @minRoot@ which have not yet been --- merged with the rest of the forest. Specifically, these are +-- +-- * @children@ is those children of @minRoot@ which have not yet been +-- merged with the rest of the forest. Specifically, these are -- the children with rank @< rk@. --- --- * @forest@ is an accumulating parameter that maintains the partial --- reconstruction of the binomial forest without @minRoot@. It is --- the union of all old roots with rank @>= rk@ (except @minRoot@), --- with the set of all children of @minRoot@ with rank @>= rk@. --- Note that @forest@ is lazy, so if we discover a smaller key +-- +-- * @forest@ is an accumulating parameter that maintains the partial +-- reconstruction of the binomial forest without @minRoot@. It is +-- the union of all old roots with rank @>= rk@ (except @minRoot@), +-- with the set of all children of @minRoot@ with rank @>= rk@. +-- Note that @forest@ is lazy, so if we discover a smaller key -- than @minKey@ later, we haven't wasted significant work. data Extract rk k a = Extract k a (rk k a) (BinomForest rk k a) @@ -329,27 +340,30 @@ incrExtract :: CompF k -> Maybe (BinomTree rk k a) -> Extract (Succ rk) k a -> Extract rk k a incrExtract _ Nothing (Extract k a (Succ t ts) tss) = Extract k a ts (Cons t tss) -incrExtract (<=) (Just t) (Extract k a (Succ t' ts) tss) - = Extract k a ts (Skip (incr (<=) (meld (<=) t t') tss)) +incrExtract le (Just t) (Extract k a (Succ t' ts) tss) + = Extract k a ts (Skip (incr le (meld le t t') tss)) -- | Walks backward from the biggest key in the forest, as far as rank @rk@. -- Returns its progress. Each successive application of @extractBin@ takes -- amortized /O(1)/ time, so applying it from the beginning takes /O(log n)/ time. extractForest :: CompF k -> BinomForest rk k a -> MExtract rk k a extractForest _ Nil = No -extractForest (<=) (Skip tss) = case extractForest (<=) tss of +extractForest le (Skip tss) = case extractForest le tss of No -> No - Yes ex -> Yes (incrExtract (<=) Nothing ex) -extractForest (<=) (Cons t@(BinomTree k a ts) tss) = Yes $ case extractForest (<=) tss of + Yes ex -> Yes (incrExtract le Nothing ex) +extractForest le (Cons t@(BinomTree k a0 ts) tss) = Yes $ case extractForest le tss of Yes ex@(Extract k' _ _ _) - | k' <? k -> incrExtract (<=) (Just t) ex - _ -> Extract k a ts (Skip tss) + | k' <? k -> incrExtract le (Just t) ex + _ -> Extract k a0 ts (Skip tss) where - a <? b = not (b <= a) + a <? b = not (b `le` a) + +extract :: (Ord k) => BinomForest rk k a -> MExtract rk k a +extract = extractForest (<=) -- | Utility function for mapping over a forest. mapForest :: (k -> a -> b) -> (rk k a -> rk k b) -> BinomForest rk k a -> BinomForest rk k b -mapForest f fCh ts = case ts of +mapForest f fCh ts0 = case ts0 of Nil -> Nil Skip ts' -> Skip (mapForest f fCh' ts') Cons (BinomTree k a ts) tss @@ -360,26 +374,26 @@ -- | Utility function for mapping a 'Maybe' function over a forest. mapMaybeF :: CompF k -> (k -> a -> Maybe b) -> (rk k a -> MinPQueue k b) -> BinomForest rk k a -> MinPQueue k b -mapMaybeF (<=) f fCh ts = case ts of +mapMaybeF le f fCh ts0 = case ts0 of Nil -> Empty - Skip ts' -> mapMaybeF (<=) f fCh' ts' + Skip ts' -> mapMaybeF le f fCh' ts' Cons (BinomTree k a ts) ts' - -> insF k a (fCh ts) (mapMaybeF (<=) f fCh' ts') - where insF k a = maybe id (insert' (<=) k) (f k a) .: union' (<=) + -> insF k a (fCh ts) (mapMaybeF le f fCh' ts') + where insF k a = maybe id (insert' le k) (f k a) .: union' le fCh' (Succ (BinomTree k a ts) tss) = insF k a (fCh ts) (fCh tss) -- | Utility function for mapping an 'Either' function over a forest. mapEitherF :: CompF k -> (k -> a -> Either b c) -> (rk k a -> (MinPQueue k b, MinPQueue k c)) -> BinomForest rk k a -> (MinPQueue k b, MinPQueue k c) -mapEitherF (<=) f fCh ts = case ts of +mapEitherF le f0 fCh ts0 = case ts0 of Nil -> (Empty, Empty) - Skip ts' -> mapEitherF (<=) f fCh' ts' + Skip ts' -> mapEitherF le f0 fCh' ts' Cons (BinomTree k a ts) ts' - -> insF k a (fCh ts) (mapEitherF (<=) f fCh' ts') + -> insF k a (fCh ts) (mapEitherF le f0 fCh' ts') where - insF k a = either (first' . insert' (<=) k) (second' . insert' (<=) k) (f k a) .: - (union' (<=) `both` union' (<=)) + insF k a = either (first' . insert' le k) (second' . insert' le k) (f0 k a) .: + (union' le `both` union' le) fCh' (Succ (BinomTree k a ts) tss) = insF k a (fCh ts) (fCh tss) both f g (x1, x2) (y1, y2) = (f x1 y1, g x2 y2) @@ -392,7 +406,7 @@ -- | /O(n)/. An unordered left fold over the elements of the queue, in no particular order. foldlWithKeyU :: (b -> k -> a -> b) -> b -> MinPQueue k a -> b foldlWithKeyU _ z Empty = z -foldlWithKeyU f z (MinPQ _ k a ts) = foldlWithKeyF_ (\ k a z -> f z k a) (const id) ts (f z k a) +foldlWithKeyU f z0 (MinPQ _ k0 a0 ts) = foldlWithKeyF_ (\ k a z -> f z k a) (const id) ts (f z0 k0 a0) traverseWithKeyU :: Applicative f => (k -> a -> f b) -> MinPQueue k a -> f (MinPQueue k b) traverseWithKeyU _ Empty = pure Empty @@ -401,40 +415,40 @@ {-# SPECIALIZE traverseForest :: (k -> a -> Identity b) -> (rk k a -> Identity (rk k b)) -> BinomForest rk k a -> Identity (BinomForest rk k b) #-} traverseForest :: (Applicative f) => (k -> a -> f b) -> (rk k a -> f (rk k b)) -> BinomForest rk k a -> f (BinomForest rk k b) -traverseForest f fCh ts = case ts of +traverseForest f fCh ts0 = case ts0 of Nil -> pure Nil Skip ts' -> Skip <$> traverseForest f fCh' ts' Cons (BinomTree k a ts) tss -> Cons <$> (BinomTree k <$> f k a <*> fCh ts) <*> traverseForest f fCh' tss - where + where fCh' (Succ (BinomTree k a ts) tss) = Succ <$> (BinomTree k <$> f k a <*> fCh ts) <*> fCh tss -- | Unordered right fold on a binomial forest. foldrWithKeyF_ :: (k -> a -> b -> b) -> (rk k a -> b -> b) -> BinomForest rk k a -> b -> b -foldrWithKeyF_ f fCh ts z = case ts of - Nil -> z - Skip ts' -> foldrWithKeyF_ f fCh' ts' z +foldrWithKeyF_ f fCh ts0 z0 = case ts0 of + Nil -> z0 + Skip ts' -> foldrWithKeyF_ f fCh' ts' z0 Cons (BinomTree k a ts) ts' - -> f k a (fCh ts (foldrWithKeyF_ f fCh' ts' z)) + -> f k a (fCh ts (foldrWithKeyF_ f fCh' ts' z0)) where fCh' (Succ (BinomTree k a ts) tss) z = f k a (fCh ts (fCh tss z)) -- | Unordered left fold on a binomial forest. foldlWithKeyF_ :: (k -> a -> b -> b) -> (rk k a -> b -> b) -> BinomForest rk k a -> b -> b -foldlWithKeyF_ f fCh ts = case ts of +foldlWithKeyF_ f fCh ts0 = case ts0 of Nil -> id Skip ts' -> foldlWithKeyF_ f fCh' ts' Cons (BinomTree k a ts) ts' -> foldlWithKeyF_ f fCh' ts' . fCh ts . f k a - where + where fCh' (Succ (BinomTree k a ts) tss) = fCh tss . fCh ts . f k a -- | Maps a monotonic function over the keys in a binomial forest. mapKeysMonoF :: (k -> k') -> (rk k a -> rk k' a) -> BinomForest rk k a -> BinomForest rk k' a -mapKeysMonoF f fCh ts = case ts of +mapKeysMonoF f fCh ts0 = case ts0 of Nil -> Nil Skip ts' -> Skip (mapKeysMonoF f fCh' ts') Cons (BinomTree k a ts) ts' @@ -445,8 +459,8 @@ -- | /O(log n)/. Analogous to @deepseq@ in the @deepseq@ package, but only forces the spine of the binomial heap. seqSpine :: MinPQueue k a -> b -> b -seqSpine Empty z = z -seqSpine (MinPQ _ _ _ ts) z = ts `seqSpineF` z where +seqSpine Empty z0 = z0 +seqSpine (MinPQ _ _ _ ts0) z0 = ts0 `seqSpineF` z0 where seqSpineF :: BinomForest rk k a -> b -> b seqSpineF ts z = case ts of Nil -> z diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pqueue-1.3.2/Data/PQueue/Prio/Max/Internals.hs new/pqueue-1.3.2.2/Data/PQueue/Prio/Max/Internals.hs --- old/pqueue-1.3.2/Data/PQueue/Prio/Max/Internals.hs 2016-09-28 15:44:50.000000000 +0200 +++ new/pqueue-1.3.2.2/Data/PQueue/Prio/Max/Internals.hs 2017-03-12 15:23:47.000000000 +0100 @@ -2,20 +2,20 @@ module Data.PQueue.Prio.Max.Internals where -import Control.Applicative -import Control.DeepSeq +import Control.DeepSeq (NFData(rnf)) -import Data.Foldable -import Data.Traversable +import Data.Traversable (Traversable(traverse)) +import Data.Foldable (Foldable(foldr, foldl)) +import Data.Functor ((<$>)) # if __GLASGOW_HASKELL__ -import Data.Data +import Data.Data (Data, Typeable) # endif import Prelude hiding (foldr, foldl) import Data.PQueue.Prio.Internals (MinPQueue) -newtype Down a = Down {unDown :: a} +newtype Down a = Down {unDown :: a} # if __GLASGOW_HASKELL__ deriving (Eq, Data, Typeable) # else diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pqueue-1.3.2/Data/PQueue/Prio/Max.hs new/pqueue-1.3.2.2/Data/PQueue/Prio/Max.hs --- old/pqueue-1.3.2/Data/PQueue/Prio/Max.hs 2016-09-28 15:44:50.000000000 +0200 +++ new/pqueue-1.3.2.2/Data/PQueue/Prio/Max.hs 2017-03-12 15:23:47.000000000 +0100 @@ -20,13 +20,13 @@ -- This implementation is based on a binomial heap augmented with a global root. -- The spine of the heap is maintained lazily. To force the spine of the heap, -- use 'seqSpine'. --- +-- -- We do not guarantee stable behavior. --- Ties are broken arbitrarily -- that is, if @k1 <= k2@ and @k2 <= k1@, then there +-- Ties are broken arbitrarily -- that is, if @k1 <= k2@ and @k2 <= k1@, then there -- are no guarantees about the relative order in which @k1@, @k2@, and their associated -- elements are returned. (Unlike Data.Map, we allow multiple elements with the -- same key.) --- +-- -- This implementation offers a number of methods of the form @xxxU@, where @U@ stands for -- unordered. No guarantees whatsoever are made on the execution or traversal order of -- these functions. @@ -39,7 +39,7 @@ insert, insertBehind, union, - unions, + unions, -- * Query null, size, @@ -116,13 +116,11 @@ ) where -import Control.Applicative hiding (empty) -import Control.Arrow -import Data.Monoid -import qualified Data.List as List +import Control.Applicative (Applicative, (<$>)) +import Data.Monoid (Monoid(mempty, mappend, mconcat)) +import Data.Traversable (Traversable(traverse)) import Data.Foldable (Foldable, foldr, foldl) -import Data.Traversable -import Data.Maybe hiding (mapMaybe) +import Data.Maybe (fromMaybe) import Data.PQueue.Prio.Max.Internals import Prelude hiding (map, filter, break, span, takeWhile, dropWhile, splitAt, take, drop, (!!), null, foldr, foldl) @@ -130,10 +128,8 @@ import qualified Data.PQueue.Prio.Min as Q #ifdef __GLASGOW_HASKELL__ -import GHC.Exts (build) import Text.Read (Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec, readListPrecDefault) -import Data.Data #else build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a] build f = f (:) [] @@ -230,7 +226,7 @@ deleteFindMax = fromMaybe (error "Error: deleteFindMax called on an empty queue") . maxViewWithKey -- | /O(1)/. Alter the value at the maximum key. If the queue is empty, does nothing. -adjustMax :: (a -> a) -> MaxPQueue k a -> MaxPQueue k a +adjustMax :: (a -> a) -> MaxPQueue k a -> MaxPQueue k a adjustMax = adjustMaxWithKey . const -- | /O(1)/. Alter the value at the maximum key. If the queue is empty, does nothing. @@ -279,23 +275,23 @@ mapKeysMonotonic :: (k -> k') -> MaxPQueue k a -> MaxPQueue k' a mapKeysMonotonic f (MaxPQ q) = MaxPQ (Q.mapKeysMonotonic (fmap f) q) --- | /O(n log n)/. Fold the keys and values in the map, such that --- @'foldrWithKey' f z q == 'List.foldr' ('uncurry' f) z ('toAscList' q)@. --- +-- | /O(n log n)/. Fold the keys and values in the map, such that +-- @'foldrWithKey' f z q == 'List.foldr' ('uncurry' f) z ('toDescList' q)@. +-- -- If you do not care about the traversal order, consider using 'foldrWithKeyU'. foldrWithKey :: Ord k => (k -> a -> b -> b) -> b -> MaxPQueue k a -> b foldrWithKey f z (MaxPQ q) = Q.foldrWithKey (f . unDown) z q --- | /O(n log n)/. Fold the keys and values in the map, such that --- @'foldlWithKey' f z q == 'List.foldl' ('uncurry' . f) z ('toAscList' q)@. --- +-- | /O(n log n)/. Fold the keys and values in the map, such that +-- @'foldlWithKey' f z q == 'List.foldl' ('uncurry' . f) z ('toDescList' q)@. +-- -- If you do not care about the traversal order, consider using 'foldlWithKeyU'. foldlWithKey :: Ord k => (b -> k -> a -> b) -> b -> MaxPQueue k a -> b -foldlWithKey f z (MaxPQ q) = Q.foldlWithKey (\ z -> f z . unDown) z q +foldlWithKey f z0 (MaxPQ q) = Q.foldlWithKey (\ z -> f z . unDown) z0 q -- | /O(n log n)/. Traverses the elements of the queue in descending order by key. -- (@'traverseWithKey' f q == 'fromDescList' <$> 'traverse' ('uncurry' f) ('toDescList' q)@) --- +-- -- If you do not care about the /order/ of the traversal, consider using 'traverseWithKeyU'. traverseWithKey :: (Ord k, Applicative f) => (k -> a -> f b) -> MaxPQueue k a -> f (MaxPQueue k b) traverseWithKey f (MaxPQ q) = MaxPQ <$> Q.traverseWithKey (f . unDown) q @@ -315,12 +311,12 @@ (xs, q') -> (fmap (first' unDown) xs, MaxPQ q') -- | Takes the longest possible prefix of elements satisfying the predicate. --- (@'takeWhile' p q == 'List.takeWhile' (p . 'snd') ('toAscList' q)@) +-- (@'takeWhile' p q == 'List.takeWhile' (p . 'snd') ('toDescList' q)@) takeWhile :: Ord k => (a -> Bool) -> MaxPQueue k a -> [(k, a)] takeWhile = takeWhileWithKey . const -- | Takes the longest possible prefix of elements satisfying the predicate. --- (@'takeWhile' p q == 'List.takeWhile' (uncurry p) ('toAscList' q)@) +-- (@'takeWhile' p q == 'List.takeWhile' (uncurry p) ('toDescList' q)@) takeWhileWithKey :: Ord k => (k -> a -> Bool) -> MaxPQueue k a -> [(k, a)] takeWhileWithKey p (MaxPQ q) = fmap (first' unDown) (Q.takeWhileWithKey (p . unDown) q) @@ -398,11 +394,11 @@ fromDescList :: [(k, a)] -> MaxPQueue k a fromDescList = MaxPQ . Q.fromAscList . fmap (first' Down) --- | /O(n log n)/. Return all keys of the queue in ascending order. +-- | /O(n log n)/. Return all keys of the queue in descending order. keys :: Ord k => MaxPQueue k a -> [k] keys = fmap fst . toDescList --- | /O(n log n)/. Return all elements of the queue in ascending order by key. +-- | /O(n log n)/. Return all elements of the queue in descending order by key. elems :: Ord k => MaxPQueue k a -> [a] elems = fmap snd . toDescList @@ -418,8 +414,8 @@ toDescList :: Ord k => MaxPQueue k a -> [(k, a)] toDescList (MaxPQ q) = fmap (first' unDown) (Q.toAscList q) --- | /O(n log n)/. Equivalent to 'toAscList'. --- +-- | /O(n log n)/. Equivalent to 'toDescList'. +-- -- If the traversal order is irrelevant, consider using 'toListU'. toList :: Ord k => MaxPQueue k a -> [(k, a)] toList = toDescList @@ -438,7 +434,7 @@ -- | /O(n)/. An unordered left fold over the elements of the queue, in no particular order. foldlWithKeyU :: (b -> k -> a -> b) -> b -> MaxPQueue k a -> b -foldlWithKeyU f z (MaxPQ q) = Q.foldlWithKeyU (\ z -> f z . unDown) z q +foldlWithKeyU f z0 (MaxPQ q) = Q.foldlWithKeyU (\ z -> f z . unDown) z0 q -- | /O(n)/. An unordered traversal over a priority queue, in no particular order. -- While there is no guarantee in which order the elements are traversed, the resulting diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pqueue-1.3.2/Data/PQueue/Prio/Min.hs new/pqueue-1.3.2.2/Data/PQueue/Prio/Min.hs --- old/pqueue-1.3.2/Data/PQueue/Prio/Min.hs 2016-09-28 15:44:50.000000000 +0200 +++ new/pqueue-1.3.2.2/Data/PQueue/Prio/Min.hs 2017-03-12 15:23:47.000000000 +0100 @@ -20,13 +20,13 @@ -- This implementation is based on a binomial heap augmented with a global root. -- The spine of the heap is maintained lazily. To force the spine of the heap, -- use 'seqSpine'. --- +-- -- We do not guarantee stable behavior. --- Ties are broken arbitrarily -- that is, if @k1 <= k2@ and @k2 <= k1@, then there +-- Ties are broken arbitrarily -- that is, if @k1 <= k2@ and @k2 <= k1@, then there -- are no guarantees about the relative order in which @k1@, @k2@, and their associated -- elements are returned. (Unlike Data.Map, we allow multiple elements with the -- same key.) --- +-- -- This implementation offers a number of methods of the form @xxxU@, where @U@ stands for -- unordered. No guarantees whatsoever are made on the execution or traversal order of -- these functions. @@ -39,7 +39,7 @@ insert, insertBehind, union, - unions, + unions, -- * Query null, size, @@ -116,22 +116,23 @@ ) where -import Control.Applicative (Applicative (..), (<$>)) -import Data.Monoid +import Control.Applicative (Applicative, pure, (<*>), (<$>)) + import qualified Data.List as List -import Data.Foldable (Foldable, foldl, foldr, foldl') -import Data.Traversable +import qualified Data.Foldable as Fold(Foldable(..)) +import Data.Monoid (Monoid(mempty, mappend, mconcat)) +import Data.Traversable (Traversable(traverse)) +import Data.Foldable (Foldable) import Data.Maybe (fromMaybe) import Data.PQueue.Prio.Internals -import Prelude hiding (map, filter, break, span, takeWhile, dropWhile, splitAt, take, drop, (!!), null, foldr) +import Prelude hiding (map, filter, break, span, takeWhile, dropWhile, splitAt, take, drop, (!!), null) #ifdef __GLASGOW_HASKELL__ import GHC.Exts (build) import Text.Read (Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec, readListPrecDefault) -import Data.Data #else build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a] build f = f (:) [] @@ -212,7 +213,7 @@ -- | /O(n log n)/. Traverses the elements of the queue in ascending order by key. -- (@'traverseWithKey' f q == 'fromAscList' <$> 'traverse' ('uncurry' f) ('toAscList' q)@) --- +-- -- If you do not care about the /order/ of the traversal, consider using 'traverseWithKeyU'. traverseWithKey :: (Ord k, Applicative f) => (k -> a -> f b) -> MinPQueue k a -> f (MinPQueue k b) traverseWithKey f q = case minViewWithKey q of @@ -253,10 +254,10 @@ -- | /O(k log n)/. Deletes the first @k@ (key, value) pairs in the queue, or returns an empty queue if @k >= n@. drop :: Ord k => Int -> MinPQueue k a -> MinPQueue k a -drop n q - | n <= 0 = q - | n >= size q = empty - | otherwise = drop' n q +drop n0 q0 + | n0 <= 0 = q0 + | n0 >= size q0 = empty + | otherwise = drop' n0 q0 where drop' n q | n == 0 = q @@ -264,7 +265,7 @@ -- | /O(k log n)/. Equivalent to @('take' k q, 'drop' k q)@. splitAt :: Ord k => Int -> MinPQueue k a -> ([(k, a)], MinPQueue k a) -splitAt n q +splitAt n q | n <= 0 = ([], q) | otherwise = n `seq` case minViewWithKey q of Just (ka, q') -> let (kas, q'') = splitAt (n-1) q' in (ka:kas, q'') @@ -280,7 +281,7 @@ -- | Takes the longest possible prefix of elements satisfying the predicate. -- (@'takeWhile' p q == 'List.takeWhile' (uncurry p) ('toAscList' q)@) takeWhileWithKey :: Ord k => (k -> a -> Bool) -> MinPQueue k a -> [(k, a)] -takeWhileWithKey p = takeWhileFB (uncurry' p) . toAscList where +takeWhileWithKey p0 = takeWhileFB (uncurry' p0) . toAscList where takeWhileFB p xs = build (\ c n -> foldr (\ x z -> if p x then x `c` z else n) n xs) -- | Removes the longest possible prefix of elements satisfying the predicate. @@ -321,10 +322,10 @@ -- | /O(n)/. Build a priority queue from a descending list of (key, value) pairs. /The precondition is not checked./ fromDescList :: [(k, a)] -> MinPQueue k a -fromDescList = foldl' (\ q (k, a) -> insertMin k a q) empty +fromDescList = List.foldl' (\ q (k, a) -> insertMin k a q) empty {-# RULES - "fromList/build" forall (g :: forall b . ((k, a) -> b -> b) -> b -> b) . + "fromList/build" forall (g :: forall b . ((k, a) -> b -> b) -> b -> b) . fromList (build g) = g (uncurry' insert) empty; "fromAscList/build" forall (g :: forall b . ((k, a) -> b -> b) -> b -> b) . fromAscList (build g) = g (uncurry' insertMin) empty; @@ -356,7 +357,7 @@ {-# INLINE toList #-} -- | /O(n log n)/. Equivalent to 'toAscList'. --- +-- -- If the traversal order is irrelevant, consider using 'toListU'. toList :: Ord k => MinPQueue k a -> [(k, a)] toList = toAscList diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pqueue-1.3.2/PQueueTests.hs new/pqueue-1.3.2.2/PQueueTests.hs --- old/pqueue-1.3.2/PQueueTests.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/pqueue-1.3.2.2/PQueueTests.hs 2017-03-12 15:23:47.000000000 +0100 @@ -0,0 +1,144 @@ +module Main (main) where + +import qualified Data.PQueue.Prio.Max as PMax () +import qualified Data.PQueue.Prio.Min as PMin () +import qualified Data.PQueue.Max as Max () +import qualified Data.PQueue.Min as Min + +import Test.QuickCheck + +import System.Exit + +import qualified Data.List as List +import Control.Arrow (second) + + +validMinToAscList :: [Int] -> Bool +validMinToAscList xs = Min.toAscList (Min.fromList xs) == List.sort xs + +validMinToDescList :: [Int] -> Bool +validMinToDescList xs = Min.toDescList (Min.fromList xs) == List.sortBy (flip compare) xs + +validMinUnfoldr :: [Int] -> Bool +validMinUnfoldr xs = List.unfoldr Min.minView (Min.fromList xs) == List.sort xs + +validMinToList :: [Int] -> Bool +validMinToList xs = List.sort (Min.toList (Min.fromList xs)) == List.sort xs + +validMinFromAscList :: [Int] -> Bool +validMinFromAscList xs = Min.fromAscList (List.sort xs) == Min.fromList xs + +validMinFromDescList :: [Int] -> Bool +validMinFromDescList xs = Min.fromDescList (List.sortBy (flip compare) xs) == Min.fromList xs + +validMinUnion :: [Int] -> [Int] -> Bool +validMinUnion xs1 xs2 = Min.union (Min.fromList xs1) (Min.fromList xs2) == Min.fromList (xs1 ++ xs2) + +validMinMapMonotonic :: [Int] -> Bool +validMinMapMonotonic xs = Min.mapU (+1) (Min.fromList xs) == Min.fromList (map (+1) xs) + +validMinFilter :: [Int] -> Bool +validMinFilter xs = Min.filter even (Min.fromList xs) == Min.fromList (List.filter even xs) + +validMinPartition :: [Int] -> Bool +validMinPartition xs = Min.partition even (Min.fromList xs) == (let (xs1, xs2) = List.partition even xs in (Min.fromList xs1, Min.fromList xs2)) + +validMinCmp :: [Int] -> [Int] -> Bool +validMinCmp xs1 xs2 = compare (Min.fromList xs1) (Min.fromList xs2) == compare (List.sort xs1) (List.sort xs2) + +validMinCmp2 :: [Int] -> Bool +validMinCmp2 xs = compare (Min.fromList ys) (Min.fromList (take 30 ys)) == compare ys (take 30 ys) + where ys = List.sort xs + +validSpan :: [Int] -> Bool +validSpan xs = (Min.takeWhile even q, Min.dropWhile even q) == Min.span even q + where q = Min.fromList xs + +validSpan2 :: [Int] -> Bool +validSpan2 xs = + second Min.toAscList (Min.span even (Min.fromList xs)) + == + List.span even (List.sort xs) + +validSplit :: Int -> [Int] -> Bool +validSplit n xs = Min.splitAt n q == (Min.take n q, Min.drop n q) + where q = Min.fromList xs + +validSplit2 :: Int -> [Int] -> Bool +validSplit2 n xs = case Min.splitAt n (Min.fromList xs) of + (ys, q') -> (ys, Min.toAscList q') == List.splitAt n (List.sort xs) + +validMapEither :: [Int] -> Bool +validMapEither xs = + Min.mapEither collatz q == + (Min.mapMaybe (either Just (const Nothing) . collatz) q, + Min.mapMaybe (either (const Nothing) Just . collatz) q) + where q = Min.fromList xs + +validMap :: [Int] -> Bool +validMap xs = Min.map f (Min.fromList xs) == Min.fromList (List.map f xs) + where f = either id id . collatz + +collatz :: Int -> Either Int Int +collatz x = + if even x + then Left $ x `quot` 2 + else Right $ 3 * x + 1 + +validSize :: [Int] -> Bool +validSize xs = Min.size q == List.length xs' + where + q = Min.drop 10 (Min.fromList xs) + xs' = List.drop 10 (List.sort xs) + +validNull :: Int -> [Int] -> Bool +validNull n xs = Min.null q == List.null xs' + where + q = Min.drop n (Min.fromList xs) + xs' = List.drop n (List.sort xs) + +validFoldl :: [Int] -> Bool +validFoldl xs = Min.foldlAsc (flip (:)) [] (Min.fromList xs) == List.foldl (flip (:)) [] (List.sort xs) + +validFoldlU :: [Int] -> Bool +validFoldlU xs = Min.foldlU (flip (:)) [] q == List.reverse (Min.foldrU (:) [] q) + where q = Min.fromList xs + +validFoldrU :: [Int] -> Bool +validFoldrU xs = Min.foldrU (+) 0 q == List.sum xs + where q = Min.fromList xs + +main :: IO () +main = do + check validMinToAscList + check validMinToDescList + check validMinUnfoldr + check validMinToList + check validMinFromAscList + check validMinFromDescList + check validMinUnion + check validMinMapMonotonic + check validMinPartition + check validMinCmp + check validMinCmp2 + check validSpan + check validSpan2 + check validSplit + check validSplit2 + check validMinFilter + check validMapEither + check validMap + check validSize + check validNull + check validFoldl + check validFoldlU + check validFoldrU + +isPass :: Result -> Bool +isPass Success{} = True +isPass _ = False + +check :: Testable prop => prop -> IO () +check p = do + r <- quickCheckResult p + if isPass r then return () else exitFailure diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pqueue-1.3.2/pqueue.cabal new/pqueue-1.3.2.2/pqueue.cabal --- old/pqueue-1.3.2/pqueue.cabal 2016-09-28 15:44:50.000000000 +0200 +++ new/pqueue-1.3.2.2/pqueue.cabal 2017-03-12 15:23:47.000000000 +0100 @@ -1,5 +1,5 @@ Name: pqueue -Version: 1.3.2 +Version: 1.3.2.2 Category: Data Structures Author: Louis Wasserman License: BSD3 @@ -11,7 +11,7 @@ Louis Wasserman <wasserman.louis@gmail.com> Bug-reports: https://github.com/lspitzner/pqueue/issues Build-type: Simple -cabal-version: >= 1.6 +cabal-version: >= 1.10 tested-with: GHC == 7.0.4, GHC == 7.2.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.1, GHC == 8.0.1 extra-source-files: { include/Typeable.h @@ -23,6 +23,8 @@ location: git@github.com:lspitzner/pqueue.git Library { + default-language: + Haskell2010 build-depends: { base >= 4 && < 4.10 , deepseq >= 1.3 && < 1.5 @@ -38,17 +40,42 @@ Data.PQueue.Prio.Max.Internals Control.Applicative.Identity if impl(ghc) { - extensions: DeriveDataTypeable + default-extensions: DeriveDataTypeable } ghc-options: { -fdicts-strict -Wall - -fno-warn-name-shadowing - -fno-warn-unused-imports } - if impl(ghc>=7.8) { - ghc-options: { - -fno-warn-inline-rule-shadowing + if impl(ghc>=7.8) { + ghc-options: { + -fno-warn-inline-rule-shadowing + } + } + if impl(ghc>=7.10) { + ghc-options: { + -fno-warn-unused-imports + } } - } } + +Test-Suite test + Type: exitcode-stdio-1.0 + Main-Is: PQueueTests.hs + Build-Depends: + { base >= 4 && < 4.10 + , deepseq >= 1.3 && < 1.5 + , QuickCheck >=2.5 && <3 + } + ghc-options: -Wall + if impl(ghc>=7.8) { + ghc-options: { + -fno-warn-inline-rule-shadowing + } + } + if impl(ghc>=7.10) { + ghc-options: { + -fno-warn-unused-imports + } + } + If impl(ghc) + Extensions: DeriveDataTypeable
participants (1)
-
root@hilbert.suse.de