diff --git a/benchmarks/BenchMinPQueue.hs b/benchmarks/BenchMinPQueue.hs new file mode 100644 index 0000000..3678e23 --- /dev/null +++ b/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 + ] + ] diff --git a/benchmarks/BenchMinQueue.hs b/benchmarks/BenchMinQueue.hs new file mode 100644 index 0000000..443c541 --- /dev/null +++ b/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 + ] + ] diff --git a/benchmarks/HeapSort.hs b/benchmarks/HeapSort.hs new file mode 100644 index 0000000..7179e87 --- /dev/null +++ b/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 diff --git a/benchmarks/KWay/MergeAlg.hs b/benchmarks/KWay/MergeAlg.hs new file mode 100644 index 0000000..a545967 --- /dev/null +++ b/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 diff --git a/benchmarks/KWay/PrioMergeAlg.hs b/benchmarks/KWay/PrioMergeAlg.hs new file mode 100644 index 0000000..9ccb7ca --- /dev/null +++ b/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 diff --git a/benchmarks/KWay/RandomIncreasing.hs b/benchmarks/KWay/RandomIncreasing.hs new file mode 100644 index 0000000..108d0dc --- /dev/null +++ b/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' diff --git a/benchmarks/PHeapSort.hs b/benchmarks/PHeapSort.hs new file mode 100644 index 0000000..6c4b9a5 --- /dev/null +++ b/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] diff --git a/pqueue.cabal b/pqueue.cabal index 1bfb0ff..6d64186 100644 --- a/pqueue.cabal +++ b/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