Add k-way merge and heapsort benchmarks

benchmarks/BenchMinPQueue.hs

@@ -0,0 +1,36 @@
+import System.Random
+import Gauge
+
+import qualified KWay.PrioMergeAlg as KWay
+import qualified PHeapSort as HS
+
+kWay :: Int -> Int -> Benchmark
+kWay i n = bench
+  ("k-way merge looking " ++ show i ++ " deep into " ++ show n ++ " streams")
+  (whnf ((!! i) . KWay.merge . KWay.mkStreams n) $ mkStdGen 5466122035931067691)
+
+hSort :: Int -> Benchmark
+hSort n = bench
+  ("Heap sort with " ++ show n ++ " elements")
+  (nf (HS.heapSortRandoms n) $ mkStdGen (-7750349139967535027))
+
+main :: IO ()
+main = defaultMainWith defaultConfig{timeLimit = Just 15}
+  [ bgroup "heapSort"
+      [ hSort (10^3)
+      , hSort (10^4)
+      , hSort (10^5)
+      ]
+  , bgroup "kWay"
+      [ kWay (10^3) 1000000
+      , kWay (10^5) 1000
+      , kWay (10^5) 10000
+      , kWay (10^5) 100000
+      , kWay (10^6) 1000
+      , kWay (10^6) 10000
+      , kWay (10^6) 20000
+      , kWay (3*10^6) 1000
+      , kWay (2*10^6) 2000
+      , kWay (4*10^6) 100
+      ]
+  ]

benchmarks/BenchMinQueue.hs

@@ -0,0 +1,36 @@
+import System.Random
+import Gauge
+
+import qualified KWay.MergeAlg as KWay
+import qualified HeapSort as HS
+
+kWay :: Int -> Int -> Benchmark
+kWay i n = bench
+  (show i ++ " into " ++ show n ++ " streams")
+  (whnf ((!! i) . KWay.merge . KWay.mkStreams n) $ mkStdGen 5466122035931067691)
+
+hSort :: Int -> Benchmark
+hSort n = bench
+  ("Heap sort with " ++ show n ++ " elements")
+  (nf (HS.heapSortRandoms n) $ mkStdGen (-7750349139967535027))
+
+main = defaultMainWith defaultConfig{timeLimit = Just 15}
+  [
+    bgroup "heapSort"
+      [ hSort (10^3)
+      , hSort (10^4)
+      , hSort (10^5)
+      ]
+  , bgroup "kWay"
+      [ kWay (10^3) 1000000
+      , kWay (10^5) 1000
+      , kWay (10^5) 10000
+      , kWay (10^5) 100000
+      , kWay (10^6) 1000
+      , kWay (10^6) 10000
+      , kWay (10^6) 20000
+      , kWay (3*10^6) 1000
+      , kWay (2*10^6) 2000
+      , kWay (4*10^6) 100
+      ]
+  ]

benchmarks/HeapSort.hs

@@ -0,0 +1,11 @@
+module HeapSort where
+
+import Data.PQueue.Min (MinQueue)
+import qualified Data.PQueue.Min as P
+import System.Random
+
+heapSortRandoms :: Int -> StdGen -> [Int]
+heapSortRandoms n gen = heapSort $ take n (randoms gen)
+
+heapSort :: Ord a => [a] -> [a]
+heapSort = P.toAscList . P.fromList

benchmarks/KWay/MergeAlg.hs

@@ -0,0 +1,36 @@
+{-# language BangPatterns #-}
+{-# language ViewPatterns #-}
+
+module KWay.MergeAlg where
+
+import qualified Data.PQueue.Min as P
+import System.Random (StdGen)
+import Data.Word
+import Data.List (unfoldr)
+import qualified KWay.RandomIncreasing as RI
+import Data.Function (on)
+import Data.Coerce
+
+newtype Stream = Stream { unStream :: RI.Stream }
+
+viewStream :: Stream -> (Word64, Stream)
+viewStream = coerce RI.viewStream
+
+instance Eq Stream where
+  (==) = (==) `on` (fst . viewStream)
+
+instance Ord Stream where
+  compare = compare `on` (fst . viewStream)
+
+type PQ = P.MinQueue
+
+merge :: [Stream] -> [Word64]
+merge = unfoldr go . P.fromList
+  where
+    go :: PQ Stream -> Maybe (Word64, PQ Stream)
+    go (P.minView -> Just (viewStream -> (a, s), ss))
+      = Just (a, P.insert s ss)
+    go _ = Nothing
+
+mkStreams :: Int -> StdGen -> [Stream]
+mkStreams = coerce RI.mkStreams

benchmarks/KWay/PrioMergeAlg.hs

@@ -0,0 +1,23 @@
+{-# language BangPatterns #-}
+{-# language ViewPatterns #-}
+
+module KWay.PrioMergeAlg
+  ( merge
+  , mkStreams
+  ) where
+
+import qualified Data.PQueue.Prio.Min as P
+import System.Random (StdGen)
+import Data.Word
+import Data.List (unfoldr)
+import KWay.RandomIncreasing
+
+type PQ = P.MinPQueue
+
+merge :: [Stream] -> [Word64]
+merge = unfoldr go . P.fromList . map viewStream
+  where
+    go :: PQ Word64 Stream -> Maybe (Word64, PQ Word64 Stream)
+    go (P.minViewWithKey -> Just ((a, viewStream -> (b, s)), ss))
+      = Just (a, P.insert b s ss)
+    go _ = Nothing

benchmarks/KWay/RandomIncreasing.hs

@@ -0,0 +1,25 @@
+{-# language BangPatterns #-}
+{-# language ViewPatterns #-}
+
+module KWay.RandomIncreasing where
+
+import System.Random
+import Data.Word
+import Data.List (unfoldr)
+
+data Stream = Stream !Word64 {-# UNPACK #-} !StdGen
+
+viewStream :: Stream -> (Word64, Stream)
+viewStream (Stream w gen) = (w, case uniform gen of (k, gen') -> Stream (w + fromIntegral (k :: Word16)) gen')
+
+mkStream :: StdGen -> (Stream, StdGen)
+mkStream gen
+  | (gen1, gen2) <- split gen
+  , (w16, gen1') <- uniform gen1
+  = (Stream (fromIntegral (w16 :: Word16)) gen1', gen2)
+
+mkStreams :: Int -> StdGen -> [Stream]
+mkStreams n gen
+  | n <= 0 = []
+  | (s, gen') <- mkStream gen
+  = s : mkStreams (n - 1) gen'

benchmarks/PHeapSort.hs

@@ -0,0 +1,11 @@
+module PHeapSort where
+
+import Data.PQueue.Prio.Min (MinPQueue)
+import qualified Data.PQueue.Prio.Min as P
+import System.Random
+
+heapSortRandoms :: Int -> StdGen -> [Int]
+heapSortRandoms n gen = heapSort $ take n (randoms gen)
+
+heapSort :: Ord a => [a] -> [a]
+heapSort xs = [b | (b, ~()) <- P.toAscList . P.fromList . map (\a -> (a, ())) $ xs]

pqueue.cabal

@@ -75,3 +75,37 @@ test-suite test
   ghc-options: {
     -Wall
   }
+
+benchmark minqueue-benchmarks
+  default-language: Haskell2010
+  type:           exitcode-stdio-1.0
+  hs-source-dirs: benchmarks
+  main-is:        BenchMinQueue.hs
+  other-modules:
+      KWay.MergeAlg
+      HeapSort
+      KWay.RandomIncreasing
+  ghc-options:    -O2
+  build-depends:
+      base              >= 4.8 && < 5
+    , pqueue
+    , deepseq           >= 1.3 && < 1.5
+    , gauge             >= 0.2.3 && < 0.3
+    , random            >= 1.2 && < 1.3
+
+benchmark minpqueue-benchmarks
+  default-language: Haskell2010
+  type:           exitcode-stdio-1.0
+  hs-source-dirs: benchmarks
+  main-is:        BenchMinPQueue.hs
+  other-modules:
+      KWay.PrioMergeAlg
+      PHeapSort
+      KWay.RandomIncreasing
+  ghc-options:    -O2
+  build-depends:
+      base              >= 4.8 && < 5
+    , pqueue
+    , deepseq           >= 1.3 && < 1.5
+    , gauge             >= 0.2.3 && < 0.3
+    , random            >= 1.2 && < 1.3