Make Prio queues more compact

benchmarks/BenchMinPQueue.hs

@@ -3,6 +3,7 @@ import Test.Tasty.Bench
 
 import qualified KWay.PrioMergeAlg as KWay
 import qualified PHeapSort as HS
+import qualified Data.PQueue.Prio.Min as P
 
 kWay :: Int -> Int -> Benchmark
 kWay i n = bench
@@ -14,6 +15,17 @@ hSort n = bench
   ("Heap sort with " ++ show n ++ " elements")
   (nf (HS.heapSortRandoms n) $ mkStdGen (-7750349139967535027))
 
+filterQ :: Int -> Benchmark
+filterQ n = bench
+  ("filter with " ++ show n ++ " elements")
+  (whnf (P.drop 1 . P.filterWithKey (>) . (P.fromList :: [(Int, Int)] -> P.MinPQueue Int Int) . take n . randoms) $ mkStdGen 977209486631198655)
+
+partitionQ :: Int -> Benchmark
+partitionQ n = bench
+  ("partition with " ++ show n ++ " elements")
+  (whnf (P.drop 1 . snd . P.partitionWithKey (>) . (P.fromList :: [(Int, Int)] -> P.MinPQueue Int Int) . take n . randoms) $ mkStdGen 781928047937198)
+
+
 main :: IO ()
 main = defaultMain
   [ bgroup "heapSort"
@@ -35,4 +47,18 @@ main = defaultMain
       , kWay (2*10^6) 2000
       , kWay (4*10^6) 100
       ]
+  , bgroup "filter"
+      [ filterQ (10^3)
+      , filterQ (10^4)
+      , filterQ (10^5)
+      , filterQ (10^6)
+      , filterQ (3*10^6)
+      ]
+  , bgroup "partition"
+      [ partitionQ (10^3)
+      , partitionQ (10^4)
+      , partitionQ (10^5)
+      , partitionQ (10^6)
+      , partitionQ (3*10^6)
+      ]
   ]

pqueue.cabal

@@ -48,6 +48,7 @@ library
     Data.PQueue.Internals.Down
     Data.PQueue.Internals.Foldable
     Data.PQueue.Prio.Max.Internals
+    Nattish
   if impl(ghc) {
     default-extensions: DeriveDataTypeable
   }
@@ -90,11 +91,13 @@ test-suite test
     Data.PQueue.Internals.Down
     Data.PQueue.Internals.Foldable
     Data.PQueue.Prio.Max.Internals
+    Nattish
 
     Validity.BinomialQueue
     Validity.PQueue.Min
     Validity.PQueue.Prio.BinomialQueue
     Validity.PQueue.Prio.Min
+    Validity.PQueue.Prio.Max
   if impl(ghc) {
     default-extensions: DeriveDataTypeable
   }

src/Data/PQueue/Internals.hs

@@ -295,6 +295,9 @@ fromList :: Ord a => [a] -> MinQueue a
 -- comparison per element.
 fromList xs = fromBare (BQ.fromList xs)
 
+-- | \(O(n)\). Assumes that the function it is given is (weakly) monotonic, and
+-- applies this function to every element of the priority queue, as in 'fmap'.
+-- If the function is not monotonic, the result is undefined.
 mapU :: (a -> b) -> MinQueue a -> MinQueue b
 mapU _ Empty = Empty
 mapU f (MinQueue n x ts) = MinQueue n (f x) (BQ.mapU f ts)

src/Data/PQueue/Internals/Foldable.hs

@@ -7,32 +7,16 @@ module Data.PQueue.Internals.Foldable
   , Foldl (..)
   , FoldMap (..)
   , Foldl' (..)
-  , IFoldr (..)
-  , IFoldl (..)
-  , IFoldMap (..)
-  , IFoldl' (..)
   ) where
 
 class Foldr t where
   foldr_ :: (a -> b -> b) -> b -> t a -> b
 
-class IFoldr t where
-  foldrWithKey_ :: (k -> a -> b -> b) -> b -> t k a -> b
-
 class Foldl t where
   foldl_ :: (b -> a -> b) -> b -> t a -> b
 
-class IFoldl t where
-  foldlWithKey_ :: (b -> k -> a -> b) -> b -> t k a -> b
-
 class FoldMap t where
   foldMap_ :: Monoid m => (a -> m) -> t a -> m
 
-class IFoldMap t where
-  foldMapWithKey_ :: Monoid m => (k -> a -> m) -> t k a -> m
-
 class Foldl' t where
   foldl'_ :: (b -> a -> b) -> b -> t a -> b
-
-class IFoldl' t where
-  foldlWithKey'_ :: (b -> k -> a -> b) -> b -> t k a -> b

src/Data/PQueue/Min.hs

@@ -263,6 +263,6 @@ keysF :: (pRk k a -> rk k) -> Prio.BinomForest pRk k a -> BinomForest rk k
 keysF f ts0 = case ts0 of
   Prio.Nil       -> Nil
   Prio.Skip ts'  -> Skip $! keysF f' ts'
-  Prio.Cons (Prio.BinomTree k _ ts) ts'
+  Prio.Cons (Prio.BinomTree k ts) ts'
     -> Cons (BinomTree k (f ts)) $! keysF f' ts'
-  where  f' (Prio.Succ (Prio.BinomTree k _ ts) tss) = Succ (BinomTree k (f ts)) (f tss)
+  where  f' (Prio.Succ (Prio.BinomTree k ts) tss) = Succ (BinomTree k (f ts)) (f tss)