PSQueue 1.1 → 1.1.0.1

raw patch · 4 files changed

+118/−110 lines, 4 filesdep ~basesetup-changednew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• Data/PSQueue.hs +90/−92
• PSQueue.cabal +22/−14
• Setup.lhs +0/−4

@@ -0,0 +1,6 @@+### 1.1.0.1++- Maintenance release+- Add support for `base-4.11.0.0`+- Fix link to ICFP paper+- Modernise packaging

@@ -9,9 +9,7 @@  This implementation is due to Ralf Hinze. -* Hinze, R., /A Simple Implementation Technique for Priority Search Queues/, ICFP 2001, pp. 110-121--<http://citeseer.ist.psu.edu/hinze01simple.html>+* [Hinze, R., A Simple Implementation Technique for Priority Search Queues, ICFP 2001, pp. 110-121](http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.18.1149)  -} @@ -19,7 +17,7 @@   module Data.PSQueue-    ( +    (     -- * Binding Type     Binding((:->))     , key@@ -36,7 +34,7 @@     -- * Insertion     , insert     , insertWith-    -- * Delete/Update +    -- * Delete/Update     , delete     , adjust     , adjustWithKey@@ -62,7 +60,7 @@     , foldl ) where -import Prelude hiding (lookup,null,foldl,foldr)+import           Prelude hiding (foldl, foldr, lookup, null) import qualified Prelude as P  {-@@ -89,7 +87,7 @@   --- | A mapping from keys @k@ to priorites @p@. +-- | A mapping from keys @k@ to priorites @p@.  data PSQ k p = Void | Winner k p (LTree k p) k @@ -103,18 +101,18 @@  -- | /O(1)/ The number of bindings in a queue. size :: PSQ k p -> Int-size Void = 0+size Void              = 0 size (Winner _ _ lt _) = 1 + size' lt  -- | /O(1)/ True if the queue is empty. null :: PSQ k p -> Bool-null Void = True+null Void             = True null (Winner _ _ _ _) = False  -- | /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-lookup k q = +lookup k q =   case tourView q of     Null -> fail "PSQueue.lookup: Empty queue"     Single k' p@@ -136,7 +134,7 @@  -- | /O(log n)/ Insert a binding into the queue. insert :: (Ord k, Ord p) => k -> p -> PSQ k p -> PSQ k p-insert k p q = +insert k p q =   case tourView q of     Null -> singleton k p     Single k' p' ->@@ -149,17 +147,17 @@       | otherwise      -> tl `play` insert k p tr  --- | /O(log n)/ Insert a binding with a combining function. +-- | /O(log n)/ Insert a binding with a combining function. insertWith :: (Ord k, Ord p) => (p->p->p) -> k -> p -> PSQ k p -> PSQ k p insertWith f = insertWithKey (\_ p p'-> f p p') --- | /O(log n)/ Insert a binding with a combining function. +-- | /O(log n)/ Insert a binding with a combining function. insertWithKey :: (Ord k, Ord p) => (k->p->p->p) -> k -> p -> PSQ k p -> PSQ k p-insertWithKey f k p q =  +insertWithKey f k p q =   case tourView q of     Null -> singleton k p     Single k' p' ->-      case compare k k' of +      case compare k k' of         LT -> singleton k  p  `play` singleton k' p'         EQ -> singleton k  (f k p p')         GT -> singleton k' p' `play` singleton k  p@@ -171,7 +169,7 @@  -- | /O(log n)/ Remove a binding from the queue. delete :: (Ord k, Ord p) => k -> PSQ k p -> PSQ k p-delete k q = +delete k q =   case tourView q of     Null -> empty     Single k' p@@ -187,7 +185,7 @@  -- | /O(log n)/ Adjust the priority of a key. adjustWithKey :: (Ord k, Ord p) => (k -> p -> p) -> k -> PSQ k p -> PSQ k p-adjustWithKey f k q =  +adjustWithKey f k q =   case tourView q of     Null -> empty     Single k' p@@ -212,10 +210,10 @@ -- to the new priority @z@.  updateWithKey :: (Ord k, Ord p) => (k -> p -> Maybe p) -> k -> PSQ k p -> PSQ k p-updateWithKey f k q =  +updateWithKey f k q =   case tourView q of     Null -> empty-    Single k' p +    Single k' p       | k==k' -> case f k p of                   Nothing -> empty                   Just p' -> singleton k p'@@ -230,11 +228,11 @@ alter :: (Ord k, Ord p) => (Maybe p -> Maybe p) -> k -> PSQ k p -> PSQ k p alter f k q =   case tourView q of-    Null -> +    Null ->       case f Nothing of         Nothing -> empty         Just p  -> singleton k p-    Single k' p +    Single k' p       | k == k'   ->  case f (Just p) of                         Nothing -> empty                         Just p' -> singleton k' p'@@ -258,11 +256,11 @@ -- | /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-fromAscList = fromDistinctAscList . stripEq -  where stripEq []         = []-        stripEq (x:xs)     = stripEq' x xs+fromAscList = fromDistinctAscList . stripEq+  where stripEq []     = []+        stripEq (x:xs) = stripEq' x xs         stripEq' x' []     = [x']-        stripEq' x' (x:xs) +        stripEq' x' (x:xs)           | x' == x   = stripEq' x' xs           | otherwise = x' : stripEq' x xs @@ -279,7 +277,7 @@   where rec 1 (a : as)    = (a, as)         rec n as          = (a1 * a2, as2)           where m         = n `div` 2-                (a1, as1) = rec (n - m) as +                (a1, as1) = rec (n - m) as                 (a2, as2) = rec m       as1  -- | /O(n)/ Convert a queue to a list.@@ -292,25 +290,25 @@  toAscLists :: (Ord k, Ord p) => 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+  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 q = seqToList (toDescLists q)  toDescLists :: (Ord k, Ord p) => PSQ k p -> Sequ (Binding k p)-toDescLists q = case tourView q of -  Null -> emptySequ-  Single k p -> singleSequ (k :-> p)-  tl `Play` tr -> toDescLists tr <> toDescLists tl+toDescLists q = case tourView q of+  Null         -> emptySequ+  Single k p   -> singleSequ (k :-> p)+  tl `Play` tr -> toDescLists tr <+> toDescLists tl   -- | /O(1)/ The binding with the lowest priority. findMin :: (Ord k, Ord p) => PSQ k p -> Maybe (Binding k p) findMin Void             = Nothing-findMin (Winner k p t m) = Just (k :-> p) +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@@ -318,13 +316,13 @@ 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. +-- the queue stripped of that binding. minView :: (Ord k, 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-secondBest Start _m = Void+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' @@ -332,7 +330,7 @@  -- | /O(r(log n - log r)/ @atMost p q@ is a list of all the bindings in @q@ with -- priority less than @p@, in order of ascending keys.--- Effectively, +-- Effectively, -- -- @ --   atMost p' q = filter (\\(k:->p) -> p<=p') . toList@@ -347,14 +345,14 @@   prune k p t     | p > pt         = emptySequ     | otherwise      = traverse k p t-  traverse k p Start = singleSequ (k :-> p)-  traverse k p (LLoser _ k' p' tl _m tr) = prune k' p' tl <> traverse k p tr-  traverse k p (RLoser _ k' p' tl _m tr) = traverse k p tl <> prune k' p' tr+  traverse k p Start                     = singleSequ (k :-> p)+  traverse k p (LLoser _ k' p' tl _m tr) = prune k' p' tl <+> traverse k p tr+  traverse k p (RLoser _ k' p' tl _m tr) = traverse k p tl <+> prune k' p' tr  -- | /O(r(log n - log r))/ @atMostRange p (l,u) q@ is a list of all the bindings in -- @q@ with a priority less than @p@ and a key in the range @(l,u)@ inclusive. -- Effectively,--- +-- -- @ --    atMostRange p' (l,u) q = filter (\\(k:->p) -> l<=k && k<=u ) . 'atMost' p' -- @@@ -372,10 +370,10 @@   traverse k p Start     | k `inrange` range = singleSequ (k :-> p)     | otherwise         = emptySequ-  traverse k p (LLoser _ k' p' tl m tr) =  -    guard (kl <= m) (prune k' p' tl) <> guard (m <= kr) (traverse k p tr)-  traverse k p (RLoser _ k' p' tl m tr) =  -    guard (kl <= m) (traverse k p tl) <> guard (m <= kr) (prune k' p' tr)+  traverse k p (LLoser _ k' p' tl m tr) =+    guard (kl <= m) (prune k' p' tl) <+> guard (m <= kr) (traverse k p tr)+  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 a `inrange` (l, r)  =  l <= a && a <= r@@ -385,20 +383,20 @@  -- | 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 f z q = +foldr f z q =   case tourView q of-    Null -> z+    Null       -> z     Single k p -> f (k:->p) z-    l`Play`r -> foldr f (foldr f z r) l-    +    l`Play`r   -> foldr f (foldr f z r) l + -- | 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 f z q = +foldl f z q =   case tourView q of-    Null -> z+    Null       -> z     Single k p -> f z (k:->p)-    l`Play`r -> foldl f (foldl f z l) r+    l`Play`r   -> foldl f (foldl f z l) r   @@ -421,11 +419,11 @@  left, right :: LTree a b -> LTree a b -left  Start                   =  error "left: empty loser tree"+left  Start                  =  error "left: empty loser tree" left  (LLoser _ _ _ tl _ _ ) =  tl left  (RLoser _ _ _ tl _ _ ) =  tl -right Start                   =  error "right: empty loser tree"+right Start                  =  error "right: empty loser tree" right (LLoser _ _ _ _  _ tr) =  tr right (RLoser _ _ _ _  _ tr) =  tr @@ -441,7 +439,7 @@ omega :: Int omega = 4 -lbalance, rbalance :: +lbalance, rbalance ::   (Ord k, Ord p) => k-> p -> LTree k p -> k -> LTree k p -> LTree k p  lbalance k p l m r@@ -480,22 +478,22 @@   | 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 -lsingleLeft k1 p1 t1 m1 (RLoser _ k2 p2 t2 m2 t3) =  +lsingleLeft k1 p1 t1 m1 (RLoser _ k2 p2 t2 m2 t3) =   rloser k2 p2 (lloser k1 p1 t1 m1 t2) m2 t3 -rsingleLeft k1 p1 t1 m1 (LLoser _ k2 p2 t2 m2 t3) =  +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) =  +rsingleLeft k1 p1 t1 m1 (RLoser _ k2 p2 t2 m2 t3) =   rloser k2 p2 (rloser k1 p1 t1 m1 t2) m2 t3 -lsingleRight k1 p1 (LLoser _ k2 p2 t1 m1 t2) m2 t3 =  +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 =  +lsingleRight k1 p1 (RLoser _ k2 p2 t1 m1 t2) m2 t3 =   lloser k1 p1 t1 m1 (lloser k2 p2 t2 m2 t3) -rsingleRight k1 p1 (LLoser _ k2 p2 t1 m1 t2) m2 t3 =  +rsingleRight k1 p1 (LLoser _ k2 p2 t1 m1 t2) m2 t3 =   lloser k2 p2 t1 m1 (rloser k1 p1 t2 m2 t3)  rsingleRight k1 p1 (RLoser _ k2 p2 t1 m1 t2) m2 t3@@ -504,28 +502,28 @@   -ldoubleLeft k1 p1 t1 m1 (LLoser _ k2 p2 t2 m2 t3) = +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) =  +ldoubleLeft k1 p1 t1 m1 (RLoser _ k2 p2 t2 m2 t3) =   lsingleLeft k1 p1 t1 m1 (rsingleRight k2 p2 t2 m2 t3) -ldoubleRight k1 p1 (LLoser _ k2 p2 t1 m1 t2) m2 t3 =  +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 =  +ldoubleRight k1 p1 (RLoser _ k2 p2 t1 m1 t2) m2 t3 =   lsingleRight k1 p1 (rsingleLeft k2 p2 t1 m1 t2) m2 t3 -rdoubleLeft k1 p1 t1 m1 (LLoser _ k2 p2 t2 m2 t3) = +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) =  +rdoubleLeft k1 p1 t1 m1 (RLoser _ k2 p2 t2 m2 t3) =   rsingleLeft k1 p1 t1 m1 (rsingleRight k2 p2 t2 m2 t3) -rdoubleRight k1 p1 (LLoser _ k2 p2 t1 m1 t2) m2 t3 =  +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 =  +rdoubleRight k1 p1 (RLoser _ k2 p2 t1 m1 t2) m2 t3 =   rsingleRight k1 p1 (rsingleLeft k2 p2 t1 m1 t2) m2 t3  @@ -556,10 +554,10 @@ tourView Void                  =  Null tourView (Winner k p Start _m) =  Single k p -tourView (Winner k p (RLoser _ k' p' tl m tr) m') =  +tourView (Winner k p (RLoser _ k' p' tl m tr) m') =   Winner k  p  tl m `Play` Winner k' p' tr m' -tourView (Winner k p (LLoser _ k' p' tl m tr) m') =  +tourView (Winner k p (LLoser _ k' p' tl m tr) m') =   Winner k' p' tl m `Play` Winner k  p  tr m'  @@ -571,23 +569,23 @@ -- Hughes's efficient sequence type -- -------------------------------------- -emptySequ  :: Sequ a-singleSequ :: a -> Sequ a-(<>)       :: Sequ a -> Sequ a -> Sequ a-seqFromList   :: [a] -> Sequ a-seqFromListT  :: ([a] -> [a]) -> Sequ a-seqToList     :: Sequ a -> [a] +emptySequ    :: Sequ a+singleSequ   :: a -> Sequ a+(<+>)        :: Sequ a -> Sequ a -> Sequ a+seqFromList  :: [a] -> Sequ a+seqFromListT :: ([a] -> [a]) -> Sequ a+seqToList    :: Sequ a -> [a] -infixr 5 <>+infixr 5 <+>  newtype Sequ a  =  Sequ ([a] -> [a]) -emptySequ          = Sequ (\as -> as)-singleSequ a       = Sequ (\as -> a : as)-Sequ x1 <> Sequ x2 = Sequ (\as -> x1 (x2 as))-seqFromList as     = Sequ (\as' -> as ++ as')-seqFromListT as    = Sequ as-seqToList (Sequ x) = x []+emptySequ           = Sequ (\as -> as)+singleSequ a        = Sequ (\as -> a : as)+Sequ x1 <+> Sequ x2 = Sequ (\as -> x1 (x2 as))+seqFromList as      = Sequ (\as' -> as ++ as')+seqFromListT as     = Sequ as+seqToList (Sequ x)  = x []  instance Show a => Show (Sequ a) where     showsPrec d a = showsPrec d (seqToList a)@@ -614,9 +612,9 @@   && isBalanced l && isBalanced r  instance (Ord k, Ord p, Arbitrary k, Arbitrary p) => Arbitrary (PSQ k p)-  where +  where     coarbitrary = undefined-    arbitrary = +    arbitrary =       do ks <- arbitrary          ps <- arbitrary          return . fromList $ zipWith (:->) ks ps@@ -629,20 +627,20 @@ prop_OrderedKeys t = let ks = map key . toAscList $ t in sort ks == ks  prop_AtMost :: (PSQ Int Int,Int) -> Bool-prop_AtMost (t,p) = -  let ps = map prio . atMost p $ t +prop_AtMost (t,p) =+  let ps = map prio . atMost p $ t   in all (<=p) ps  prop_AtMostRange :: (PSQ Int Int,Int,Int,Int) -> Bool-prop_AtMostRange (t,p,l_,r_) = +prop_AtMostRange (t,p,l_,r_) =   let l = min (abs l_) (abs r_)       r = max (abs l_) (abs r_)-      (ks,ps) = unzip . map (\b -> (key b,prio b)) . atMostRange p (l,r) $ t +      (ks,ps) = unzip . map (\b -> (key b,prio b)) . atMostRange p (l,r) $ t   in  all (flip inrange (l,r)) ks && all (<=p) ps  prop_MinView :: PSQ Int Int -> Bool-prop_MinView t = -  case minView t of +prop_MinView t =+  case minView t of     Nothing -> True     Just (b1,t') ->       case minView t' of

@@ -1,12 +1,16 @@-Name:                PSQueue-Version:             1.1-License:             BSD3-License-file:        LICENSE-Author:              Ralf Hinze-Maintainer:          Scott E. Dillard <sedillard@gmail.com>-Stability:           Experimental-Synopsis:            Priority Search Queue-Description:         A /priority search queue/ efficiently supports the+cabal-version:       2.0+name:                PSQueue+version:             1.1.0.1++build-type:          Simple+license:             BSD3+license-file:        LICENSE+author:              Ralf Hinze+maintainer:          Hackage Trustees <trustees@hackage.haskell.org>+bug-reports:         https://github.com/hackage-trustees/PSQueue/issues+synopsis:            Priority Search Queue+category:            Data Structures+description:         A /priority search queue/ efficiently supports the                      opperations 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@@ -14,10 +18,14 @@                      can be retrieved in constant time.  A queue can be built                      from a list of bindings, sorted by keys, in linear time. -Cabal-version:       >=1.2-Build-type:          Simple-Category:            Data Structures+extra-source-files:  ChangeLog.md+source-repository head+    type: git+    location: https://github.com/hackage-trustees/PSQueue.git  library-    Build-Depends:      base-    Exposed-modules:    Data.PSQueue +    exposed-modules:    Data.PSQueue+    default-language:   Haskell2010+    if impl(ghc > 7.2)+      default-extensions: Safe+    build-depends:      base >= 4.3 && < 4.13

@@ -1,4 +0,0 @@-#! /usr/bin/env runhaskell--> import Distribution.Simple-> main = defaultMain