PSQueue 1.1.1 → 1.2.0

raw patch · 4 files changed

+100/−65 lines, 4 filesdep ~QuickCheckdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: QuickCheck, base

API changes (from Hackage documentation)

Files

• ChangeLog.md +9/−1
• PSQueue.cabal +5/−5
• src/Data/PSQueue.hs +1/−1
• src/Data/PSQueue/Internal.hs +85/−58

@@ -1,7 +1,15 @@+### 1.2.0++- Fix typos (Thanks to @Moiman) [#8](https://github.com/PSQueue/PSQueue/pull/8)+- Improve performance, strictness, and remove redundant constraints (Thanks to @treeowl) [#9](https://github.com/PSQueue/PSQueue/pull/9)+- Support GHC-9.4 [#6](https://github.com/PSQueue/PSQueue/pull/6)+- Support GHC-9.6 [#9](https://github.com/PSQueue/PSQueue/pull/9)++ ### 1.1.1  - Teo Camarasu takes over as maintainer [#1](https://github.com/TeofilC/PSQueue/pull/1)-- Relax base bound to allow compatiblity with GHC-9.0 and GHC-9.2 [#2](https://github.com/TeofilC/PSQueue/pull/2)+- Relax base bound to allow compatibility with GHC-9.0 and GHC-9.2 [#2](https://github.com/TeofilC/PSQueue/pull/2) - Add test suite and basic Github Actions CI [#3](https://github.com/TeofilC/PSQueue/pull/3)  

@@ -1,6 +1,6 @@ cabal-version:      2.0 name:               PSQueue-version:            1.1.1+version:            1.2.0 build-type:         Simple license:            BSD3 license-file:       LICENSE@@ -11,14 +11,14 @@ category:           Data Structures description:   A /priority search queue/ efficiently supports the-  opperations of both a search tree and a priority queue. A+  operations of both a search tree and a priority queue. A   'Binding' is a product of a key and a priority.  Bindings   can be inserted, deleted, modified and queried in   logarithmic time, and the binding with the least priority   can be retrieved in constant time.  A queue can be built   from a list of bindings, sorted by keys, in linear time. -tested-with:        GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.2+tested-with:        GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.4 || ==9.4.1 || ==9.6.1 extra-source-files: ChangeLog.md  source-repository head@@ -36,7 +36,7 @@   if impl(ghc >7.2)     default-extensions: Safe -  build-depends:    base >=4.3 && <4.17+  build-depends:    base >=4.3 && <4.19  test-suite test   type:             exitcode-stdio-1.0@@ -46,4 +46,4 @@   build-depends:       base     , PSQueue-    , QuickCheck+    , QuickCheck < 3

@@ -1,7 +1,7 @@ {- |  A /priority search queue/ (henceforth /queue/) efficiently supports the-opperations of both a search tree and a priority queue. A 'Binding' is a+operations of both a search tree and a priority queue. A 'Binding' is a product of a key and a priority. Bindings can be inserted, deleted, modified and queried in logarithmic time, and the binding with the least priority can be retrieved in constant time. A queue can be built from a list of bindings,

@@ -73,16 +73,16 @@   , rdoubleLeft   , rdoubleRight   , play-  , unsafePlay   , TourView(..)   , tourView   ) where +import           Data.Function (on) import           Prelude hiding (foldl, foldr, lookup, null) import qualified Prelude as P  -- | @k :-> p@ binds the key @k@ with the priority @p@.-data Binding k p = k :-> p deriving (Eq,Ord,Show,Read)+data Binding k p = !k :-> !p deriving (Eq,Ord,Show,Read)  infix 0 :-> @@ -97,14 +97,15 @@  -- | A mapping from keys @k@ to priorites @p@. -data PSQ k p = Void | Winner k p (LTree k p) k+data PSQ k p = Void | Winner !k !p !(LTree k p) !k -instance (Show k, Show p, Ord k, Ord p) => Show (PSQ k p) where+instance (Show k, Show p) => Show (PSQ k p) where   show = show . toAscList   --show Void = "[]"   --show (Winner k1 p lt k2) = "Winner "++show k1++" "++show p++" ("++show lt++") "++show k2 -+instance (Eq k, Eq p) => Eq (PSQ k p) where+  (==) = (==) `on` toAscList   -- | /O(1)/ The number of bindings in a queue.@@ -119,7 +120,8 @@  -- | /O(log n)/ The priority of a given key, or Nothing if the key is not -- bound.-lookup :: (Ord k, Ord p) => k -> PSQ k p -> Maybe p+{-# INLINABLE lookup #-}+lookup :: Ord k => k -> PSQ k p -> Maybe p lookup k q =   case tourView q of     Null -> fail "PSQueue.lookup: Empty queue"@@ -132,15 +134,16 @@   -empty :: (Ord k, Ord p) => PSQ k p+empty :: PSQ k p empty = Void  -- | O(1) Build a queue with one binding.-singleton :: (Ord k, Ord p) => k -> p -> PSQ k p+singleton :: k -> p -> PSQ k p singleton k p =  Winner k p Start k   -- | /O(log n)/ Insert a binding into the queue.+{-# INLINABLE insert #-} insert :: (Ord k, Ord p) => k -> p -> PSQ k p -> PSQ k p insert k p q =   case tourView q of@@ -160,6 +163,7 @@ insertWith f = insertWithKey (\_ p p'-> f p p')  -- | /O(log n)/ Insert a binding with a combining function.+{-# INLINABLE insertWithKey #-} insertWithKey :: (Ord k, Ord p) => (k->p->p->p) -> k -> p -> PSQ k p -> PSQ k p insertWithKey f k p q =   case tourView q of@@ -170,12 +174,13 @@         EQ -> singleton k  (f k p p')         GT -> singleton k' p' `play` singleton k  p     tl `Play` tr-      | k <= maxKey tl -> insertWithKey f k p tl `unsafePlay` tr-      | otherwise      -> tl `unsafePlay` insertWithKey f k p tr+      | k <= maxKey tl -> insertWithKey f k p tl `play` tr+      | otherwise      -> tl `play` insertWithKey f k p tr    -- | /O(log n)/ Remove a binding from the queue.+{-# INLINABLE delete #-} delete :: (Ord k, Ord p) => k -> PSQ k p -> PSQ k p delete k q =   case tourView q of@@ -192,6 +197,7 @@ adjust f = adjustWithKey (\_ p -> f p)  -- | /O(log n)/ Adjust the priority of a key.+{-# INLINABLE adjustWithKey #-} adjustWithKey :: (Ord k, Ord p) => (k -> p -> p) -> k -> PSQ k p -> PSQ k p adjustWithKey f k q =   case tourView q of@@ -200,8 +206,8 @@       | k == k'   -> singleton k' (f k p)       | otherwise -> singleton k' p     tl `Play` tr-      | k <= maxKey tl -> adjustWithKey f k tl `unsafePlay` tr-      | otherwise      -> tl `unsafePlay` adjustWithKey f k tr+      | k <= maxKey tl -> adjustWithKey f k tl `play` tr+      | otherwise      -> tl `play` adjustWithKey f k tr   -- | /O(log n)/ The expression (@update f k q@) updates the@@ -217,6 +223,7 @@ -- the binding is deleted. If it is (@'Just' z@), the key @k@ is bound -- to the new priority @z@. +{-# INLINABLE updateWithKey #-} updateWithKey :: (Ord k, Ord p) => (k -> p -> Maybe p) -> k -> PSQ k p -> PSQ k p updateWithKey f k q =   case tourView q of@@ -227,12 +234,14 @@                   Just p' -> singleton k p'       | otherwise -> singleton k' p     tl `Play` tr-      | k <= maxKey tl -> updateWithKey f k tl `unsafePlay` tr-      | otherwise      -> tl `unsafePlay` updateWithKey f k tr+      | k <= maxKey tl -> updateWithKey f k tl `play` tr+      | otherwise      -> tl `play` updateWithKey f k tr   -- | /O(log n)/. The expression (@'alter' f k q@) alters the priority @p@ bound to @k@, or absence thereof. -- alter can be used to insert, delete, or update a priority in a queue.++{-# INLINABLE alter #-} alter :: (Ord k, Ord p) => (Maybe p -> Maybe p) -> k -> PSQ k p -> PSQ k p alter f k q =   case tourView q of@@ -248,13 +257,13 @@                         Nothing -> singleton k' p                         Just p' -> insert k p' $ singleton k' p     tl `Play` tr-      | k <= maxKey tl -> alter f k tl `unsafePlay` tr-      | otherwise      -> tl `unsafePlay` alter f k tr+      | k <= maxKey tl -> alter f k tl `play` tr+      | otherwise      -> tl `play` alter f k tr    -- | /O(n)/ The keys of a priority queue-keys :: (Ord k, Ord p) => PSQ k p -> [k]+keys :: PSQ k p -> [k] keys = map key . toList  -- | /O(n log n)/ Build a queue from a list of bindings.@@ -263,7 +272,8 @@  -- | /O(n)/ Build a queue from a list of bindings in order of -- ascending keys. The precondition that the keys are ascending is not checked.-fromAscList :: (Ord k, Ord p) => [Binding k p] -> PSQ k p+{-# INLINABLE fromAscList #-}+fromAscList :: (Eq k, Ord p) => [Binding k p] -> PSQ k p fromAscList = fromDistinctAscList . stripEq   where stripEq []     = []         stripEq (x:xs) = stripEq' x xs@@ -274,8 +284,9 @@  -- | /O(n)/ Build a queue from a list of distinct bindings in order of -- ascending keys. The precondition that keys are distinct and ascending is not checked.-fromDistinctAscList :: (Ord k, Ord p) => [Binding k p] -> PSQ k p-fromDistinctAscList = foldm unsafePlay empty . map (\(k:->p) -> singleton k p)+{-# INLINABLE fromDistinctAscList #-}+fromDistinctAscList :: Ord p => [Binding k p] -> PSQ k p+fromDistinctAscList = foldm play empty . map (\(k:->p) -> singleton k p)  -- Folding a list in a binary-subdivision scheme. foldm :: (a -> a -> a) -> a -> [a] -> a@@ -289,24 +300,24 @@                 (a2, as2) = rec m       as1  -- | /O(n)/ Convert a queue to a list.-toList :: (Ord k, Ord p) => PSQ k p -> [Binding k p]+toList :: PSQ k p -> [Binding k p] toList = toAscList  -- | /O(n)/ Convert a queue to a list in ascending order of keys.-toAscList :: (Ord k, Ord p) => PSQ k p -> [Binding k p]+toAscList :: PSQ k p -> [Binding k p] toAscList q  = seqToList (toAscLists q) -toAscLists :: (Ord k, Ord p) => PSQ k p -> Sequ (Binding k p)+toAscLists :: PSQ k p -> Sequ (Binding k p) toAscLists q = case tourView q of   Null         -> emptySequ   Single k p   -> singleSequ (k :-> p)   tl `Play` tr -> toAscLists tl <+> toAscLists tr  -- | /O(n)/ Convert a queue to a list in descending order of keys.-toDescList :: (Ord k, Ord p) => PSQ k p -> [ Binding k p ]+toDescList :: PSQ k p -> [ Binding k p ] toDescList q = seqToList (toDescLists q) -toDescLists :: (Ord k, Ord p) => PSQ k p -> Sequ (Binding k p)+toDescLists :: PSQ k p -> Sequ (Binding k p) toDescLists q = case tourView q of   Null         -> emptySequ   Single k p   -> singleSequ (k :-> p)@@ -314,22 +325,23 @@   -- | /O(1)/ The binding with the lowest priority.-findMin :: (Ord k, Ord p) => PSQ k p -> Maybe (Binding k p)+findMin :: PSQ k p -> Maybe (Binding k p) findMin Void             = Nothing findMin (Winner k p t m) = Just (k :-> p)  -- | /O(log n)/ Remove the binding with the lowest priority.-deleteMin :: (Ord k, Ord p) => PSQ k p -> PSQ k p+deleteMin :: Ord p => PSQ k p -> PSQ k p deleteMin Void             = Void deleteMin (Winner k p t m) = secondBest t m  -- | /O(log n)/ Retrieve the binding with the least priority, and the rest of -- the queue stripped of that binding.-minView :: (Ord k, Ord p) => PSQ k p -> Maybe (Binding k p, PSQ k p)+minView :: Ord p => PSQ k p -> Maybe (Binding k p, PSQ k p) minView Void             = Nothing minView (Winner k p t m) = Just ( k :-> p , secondBest t m ) -secondBest :: (Ord k, Ord p) => LTree k p -> k -> PSQ k p+{-# INLINABLE secondBest #-}+secondBest :: Ord p => LTree k p -> k -> PSQ k p secondBest Start _m                  = Void secondBest (LLoser _ k p tl m tr) m' = Winner k p tl m `play` secondBest tr m' secondBest (RLoser _ k p tl m tr) m' = secondBest tl m `play` Winner k p tr m'@@ -343,10 +355,10 @@ -- @ --   atMost p' q = filter (\\(k:->p) -> p<=p') . toList -- @-atMost :: (Ord k, Ord p) => p -> PSQ k p -> [Binding k p]+atMost :: Ord p => p -> PSQ k p -> [Binding k p] atMost pt q = seqToList (atMosts pt q) -atMosts :: (Ord k, Ord p) => p -> PSQ k p -> Sequ (Binding k p)+atMosts :: Ord p => p -> PSQ k p -> Sequ (Binding k p) atMosts _pt Void  = emptySequ atMosts pt (Winner k p t _) =  prune k p t   where@@ -364,11 +376,12 @@ -- @ --    atMostRange p' (l,u) q = filter (\\(k:->p) -> l<=k && k<=u ) . 'atMost' p' -- @+{-# INLINABLE atMostRange #-} atMostRange :: (Ord k, Ord p) => p -> (k, k) -> PSQ k p -> [Binding k p] atMostRange pt (kl, kr) q = seqToList (atMostRanges pt (kl, kr) q) +{-# INLINABLE atMostRanges #-} atMostRanges :: (Ord k, Ord p) => p -> (k, k) -> PSQ k p -> Sequ (Binding k p)- atMostRanges _pt _range Void = emptySequ atMostRanges pt range@(kl, kr) (Winner k p t _) = prune k p t   where@@ -383,14 +396,15 @@   traverse k p (RLoser _ k' p' tl m tr) =     guard (kl <= m) (traverse k p tl) <+> guard (m <= kr) (prune k' p' tr) -inrange :: (Ord a) => a -> (a, a) -> Bool+{-# INLINE inrange #-}+inrange :: Ord a => a -> (a, a) -> Bool a `inrange` (l, r)  =  l <= a && a <= r     -- | Right fold over the bindings in the queue, in key order.-foldr :: (Ord k,Ord p) => (Binding k p -> b -> b) -> b -> PSQ k p -> b+foldr :: (Binding k p -> b -> b) -> b -> PSQ k p -> b foldr f z q =   case tourView q of     Null       -> z@@ -399,7 +413,7 @@   -- | Left fold over the bindings in the queue, in key order.-foldl :: (Ord k,Ord p) => (b -> Binding k p -> b) -> b -> PSQ k p -> b+foldl :: (b -> Binding k p -> b) -> b -> PSQ k p -> b foldl f z q =   case tourView q of     Null       -> z@@ -416,8 +430,8 @@ type Size = Int  data LTree k p = Start-               | LLoser {-# UNPACK #-}!Size !k !p (LTree k p) !k (LTree k p)-               | RLoser {-# UNPACK #-}!Size !k !p (LTree k p) !k (LTree k p)+               | LLoser {-# UNPACK #-}!Size !k !p !(LTree k p) !k !(LTree k p)+               | RLoser {-# UNPACK #-}!Size !k !p !(LTree k p) !k !(LTree k p)   size' :: LTree k p -> Size@@ -447,41 +461,53 @@ omega :: Int omega = 4 +{-# INLINABLE lbalance #-}+{-# INLINABLE rbalance #-} lbalance, rbalance ::-  (Ord k, Ord p) => k-> p -> LTree k p -> k -> LTree k p -> LTree k p+  Ord p => k -> p -> LTree k p -> k -> LTree k p -> LTree k p +lbalance k p Start m r        = lloser        k p Start m r+lbalance k p l m Start        = lloser        k p l m Start lbalance k p l m r-  | size' l + size' r < 2     = lloser        k p l m r   | size' r > omega * size' l = lbalanceLeft  k p l m r   | size' l > omega * size' r = lbalanceRight k p l m r   | otherwise               = lloser        k p l m r +rbalance k p Start m r        = rloser        k p Start m r+rbalance k p l m Start        = rloser        k p l m Start rbalance k p l m r-  | size' l + size' r < 2     = rloser        k p l m r   | size' r > omega * size' l = rbalanceLeft  k p l m r   | size' l > omega * size' r = rbalanceRight k p l m r   | otherwise               = rloser        k p l m r +{-# INLINABLE lbalanceLeft #-}+lbalanceLeft :: Ord p => k -> p -> LTree k p -> k -> LTree k p -> LTree k p lbalanceLeft  k p l m r   | size' (left r) < size' (right r) = lsingleLeft  k p l m r   | otherwise                      = ldoubleLeft  k p l m r +{-# INLINABLE lbalanceRight #-}+lbalanceRight :: Ord p => k -> p -> LTree k p -> k -> LTree k p -> LTree k p lbalanceRight k p l m r   | size' (left l) > size' (right l) = lsingleRight k p l m r   | otherwise                      = ldoubleRight k p l m r -+{-# INLINABLE rbalanceLeft #-}+rbalanceLeft :: Ord p => k -> p -> LTree k p -> k -> LTree k p -> LTree k p rbalanceLeft  k p l m r   | size' (left r) < size' (right r) = rsingleLeft  k p l m r   | otherwise                      = rdoubleLeft  k p l m r +{-# INLINABLE rbalanceRight #-}+rbalanceRight :: Ord p => k -> p -> LTree k p -> k -> LTree k p -> LTree k p rbalanceRight k p l m r   | size' (left l) > size' (right l) = rsingleRight k p l m r   | otherwise                      = rdoubleRight k p l m r   -+{-# INLINABLE lsingleLeft #-}+lsingleLeft :: Ord p => k -> p -> LTree k p -> k -> LTree k p -> LTree k p lsingleLeft k1 p1 t1 m1 (LLoser _ k2 p2 t2 m2 t3)   | p1 <= p2  = lloser k1 p1 (rloser k2 p2 t1 m1 t2) m2 t3   | otherwise = lloser k2 p2 (lloser k1 p1 t1 m1 t2) m2 t3@@ -489,18 +515,22 @@ lsingleLeft k1 p1 t1 m1 (RLoser _ k2 p2 t2 m2 t3) =   rloser k2 p2 (lloser k1 p1 t1 m1 t2) m2 t3 +rsingleLeft :: k -> p -> LTree k p -> k -> LTree k p -> LTree k p rsingleLeft k1 p1 t1 m1 (LLoser _ k2 p2 t2 m2 t3) =   rloser k1 p1 (rloser k2 p2 t1 m1 t2) m2 t3  rsingleLeft k1 p1 t1 m1 (RLoser _ k2 p2 t2 m2 t3) =   rloser k2 p2 (rloser k1 p1 t1 m1 t2) m2 t3 +lsingleRight :: k -> p -> LTree k p -> k -> LTree k p -> LTree k p lsingleRight k1 p1 (LLoser _ k2 p2 t1 m1 t2) m2 t3 =   lloser k2 p2 t1 m1 (lloser k1 p1 t2 m2 t3)  lsingleRight k1 p1 (RLoser _ k2 p2 t1 m1 t2) m2 t3 =   lloser k1 p1 t1 m1 (lloser k2 p2 t2 m2 t3) +{-# INLINABLE rsingleRight #-}+rsingleRight :: Ord p => k -> p -> LTree k p -> k -> LTree k p -> LTree k p rsingleRight k1 p1 (LLoser _ k2 p2 t1 m1 t2) m2 t3 =   lloser k2 p2 t1 m1 (rloser k1 p1 t2 m2 t3) @@ -509,33 +539,40 @@   | otherwise = rloser k2 p2 t1 m1 (rloser k1 p1 t2 m2 t3)  -+{-# INLINABLE ldoubleLeft #-}+ldoubleLeft :: Ord p => k -> p -> LTree k p -> k -> LTree k p -> LTree k p ldoubleLeft k1 p1 t1 m1 (LLoser _ k2 p2 t2 m2 t3) =   lsingleLeft k1 p1 t1 m1 (lsingleRight k2 p2 t2 m2 t3)  ldoubleLeft k1 p1 t1 m1 (RLoser _ k2 p2 t2 m2 t3) =   lsingleLeft k1 p1 t1 m1 (rsingleRight k2 p2 t2 m2 t3) +{-# INLINABLE ldoubleRight #-}+ldoubleRight :: Ord p => k -> p -> LTree k p -> k -> LTree k p -> LTree k p ldoubleRight k1 p1 (LLoser _ k2 p2 t1 m1 t2) m2 t3 =   lsingleRight k1 p1 (lsingleLeft k2 p2 t1 m1 t2) m2 t3  ldoubleRight k1 p1 (RLoser _ k2 p2 t1 m1 t2) m2 t3 =   lsingleRight k1 p1 (rsingleLeft k2 p2 t1 m1 t2) m2 t3 +{-# INLINABLE rdoubleLeft #-}+rdoubleLeft :: Ord p => k -> p -> LTree k p -> k -> LTree k p -> LTree k p rdoubleLeft k1 p1 t1 m1 (LLoser _ k2 p2 t2 m2 t3) =   rsingleLeft k1 p1 t1 m1 (lsingleRight k2 p2 t2 m2 t3)  rdoubleLeft k1 p1 t1 m1 (RLoser _ k2 p2 t2 m2 t3) =   rsingleLeft k1 p1 t1 m1 (rsingleRight k2 p2 t2 m2 t3) +{-# INLINABLE rdoubleRight #-}+rdoubleRight :: Ord p => k -> p -> LTree k p -> k -> LTree k p -> LTree k p rdoubleRight k1 p1 (LLoser _ k2 p2 t1 m1 t2) m2 t3 =   rsingleRight k1 p1 (lsingleLeft k2 p2 t1 m1 t2) m2 t3  rdoubleRight k1 p1 (RLoser _ k2 p2 t1 m1 t2) m2 t3 =   rsingleRight k1 p1 (rsingleLeft k2 p2 t1 m1 t2) m2 t3 --play :: (Ord k, Ord p) => PSQ k p -> PSQ k p -> PSQ k p+{-# INLINABLE play #-}+play :: Ord p => PSQ k p -> PSQ k p -> PSQ k p  Void `play` t' = t' t `play` Void  = t@@ -544,21 +581,11 @@   | p <= p'   = Winner k  p  (rbalance k' p' t m t') m'   | otherwise = Winner k' p' (lbalance k  p  t m t') m' -unsafePlay :: (Ord k, Ord p) => PSQ k p -> PSQ k p -> PSQ k p -Void `unsafePlay` t' =  t'-t `unsafePlay` Void  =  t--Winner k p t m  `unsafePlay`  Winner k' p' t' m'-  | p <= p'   = Winner k  p  (rbalance k' p' t m t') m'-  | otherwise = Winner k' p' (lbalance k  p  t m t') m'----data TourView k p = Null | Single k p | PSQ k p `Play` PSQ k p--tourView :: (Ord k) => PSQ k p -> TourView k p+data TourView k p = Null | Single !k !p | !(PSQ k p) `Play` !(PSQ k p) +tourView :: PSQ k p -> TourView k p+{-# INLINE tourView #-} tourView Void                  =  Null tourView (Winner k p Start _m) =  Single k p