diff --git a/apply-merge.cabal b/apply-merge.cabal index b2b0e6e..b7b4e25 100644 --- a/apply-merge.cabal +++ b/apply-merge.cabal @@ -26,6 +26,7 @@ extra-doc-files: README.md ChangeLog.md docs/ALGORITHM.md + docs/Benchmark.md LICENSES/BSD-3-Clause.txt source-repository head @@ -98,6 +99,7 @@ benchmark apply-merge-benchmarks Data.List.ApplyMerge Data.List.NonEmpty.ApplyMerge Data.PQueue.Prio.Min.Mutable + Bench.ApplyMerge Bench.Data.DoublyLinkedList.STRef Bench.PriorityQueue.MinPQueue Bench.PriorityQueue.MinPQueue.Mutable diff --git a/bench/Bench/ApplyMerge.hs b/bench/Bench/ApplyMerge.hs new file mode 100644 index 0000000..486cefb --- /dev/null +++ b/bench/Bench/ApplyMerge.hs @@ -0,0 +1,90 @@ +-- SPDX-FileCopyrightText: Copyright Preetham Gujjula +-- SPDX-License-Identifier: BSD-3-Clause +{-# LANGUAGE ImpredicativeTypes #-} + +module Bench.ApplyMerge (benchmarks) where + +import ApplyMerge.DoublyLinkedList qualified +import ApplyMerge.IntMap qualified +import ApplyMerge.IntSet qualified +import ApplyMerge.MergeAll qualified +import Data.Function ((&)) +import Data.List.Ordered (minus) +import Test.Tasty.Bench (Benchmark, bench, bgroup, nf) + +benchmarks :: Benchmark +benchmarks = + bgroup + "applyMerge" + [ funcToBenchmark + "linear shape: applyMerge const [1..] [1..]" + const, + funcToBenchmark + "double linear shape: applyMerge min [1..] [1..]" + min, + funcToBenchmark + "triangular shape: applyMerge (+) [1..] [1..]" + (+), + funcToBenchmark + "skewed triangular shape: applyMerge (\\x y -> 4 * x + y) [1..] [1..]" + (\x y -> 4 * x + y), + funcToBenchmark + "hyperbolic shape: applyMerge (*) [1..] [1..]" + (*), + funcToBenchmark + "skewed hyperbolic shape: applyMerge (\\x y -> x^3 * y) [1..] [1..]" + ( \x y -> + floor @Double $ + 100 * (3 * log (fromIntegral x + fromIntegral y)) + ), + funcToBenchmark + "circular shape: applyMerge (\\x y -> x*x + y*y) [1..] [1..]" + (\x y -> x * x + y * y), + funcToBenchmark + "elliptical shape: applyMerge (\\x y -> 4*x*x + y*y) [1..] [1..]" + (\x y -> 4 * x * x + y * y), + collapseToBenchmark "primes" $ \applyMerge n -> + let zero :: Int + zero = (n `quot` maxBound) + + primes :: [Int] + primes = 2 : 3 : 5 : ([7 ..] `minus` composites) + + composites :: [Int] + composites = applyMerge (\p j -> p * (p + j)) primes [zero ..] + in sum (takeWhile (<= n) primes) + ] + +type ApplyMerge = forall a b c. (Ord c) => (a -> b -> c) -> [a] -> [b] -> [c] + +funcToBenchmark :: String -> (Int -> Int -> Int) -> Benchmark +funcToBenchmark name f = collapseToBenchmark name (funcToCollapse f) + +funcToCollapse :: (Int -> Int -> Int) -> ApplyMerge -> Int -> Int +funcToCollapse f applyMerge n = + let one = (n `quot` maxBound) + 1 + in applyMerge f [one ..] [one ..] + & take n + & sum + +collapseToBenchmark :: String -> (ApplyMerge -> Int -> Int) -> Benchmark +collapseToBenchmark name collapse = bgroup name (map mkBench [1 .. 6]) + where + mkBench :: Int -> Benchmark + mkBench i = + let limit :: Int + limit = 10 ^ i + + applyMerges :: [(String, ApplyMerge)] + applyMerges = + [ ("DoublyLinkedList", ApplyMerge.DoublyLinkedList.applyMerge), + ("IntMap", ApplyMerge.IntMap.applyMerge), + ("IntSet", ApplyMerge.IntSet.applyMerge), + ("MergeAll", ApplyMerge.MergeAll.applyMerge), + ( "MergeAll (flipped)", + flip . ApplyMerge.MergeAll.applyMerge . flip + ) + ] + in bgroup (show limit) $ + flip map applyMerges $ \(applyMergeName, applyMerge) -> + bench applyMergeName (nf (collapse applyMerge) limit) diff --git a/bench/Main.hs b/bench/Main.hs index 88c0ac6..b1977ae 100644 --- a/bench/Main.hs +++ b/bench/Main.hs @@ -12,6 +12,7 @@ import Bench.PriorityQueue.MinPQueue qualified import Bench.PriorityQueue.MinPQueue.Mutable qualified import Data.Function ((&)) import Test.Tasty.Bench (Benchmark, bench, bgroup, defaultMain, nf) +import Bench.ApplyMerge qualified main :: IO () main = @@ -22,6 +23,7 @@ main = benchCommon "IntMap" ApplyMerge.IntMap.applyMerge, benchCommon "IntSet" ApplyMerge.IntSet.applyMerge, benchCommon "MergeAll" ApplyMerge.MergeAll.applyMerge, + Bench.ApplyMerge.benchmarks, Bench.Data.DoublyLinkedList.STRef.benchmarks, Bench.PriorityQueue.MinPQueue.benchmarks, Bench.PriorityQueue.MinPQueue.Mutable.benchmarks diff --git a/docs/Benchmark.md b/docs/Benchmark.md new file mode 100644 index 0000000..5053483 --- /dev/null +++ b/docs/Benchmark.md @@ -0,0 +1,223 @@ +We benchmark the performance of the `applyMerge` implementations on different +"shapes" of generated elements. + +* Linear: `applyMerge const [1..] [1..]` +
+ Shape + + . . . . . . . . . . . . . . . + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * +
+ +* Double linear: `applyMerge min [1..] [1..]` +
+ Shape + + . . . . . . . . . . . . . . . + . * * * * * * * * * * * * * * + . * * * * * * * * * * * * * * + . * * * * * * * * * * * * * * + . * * * * * * * * * * * * * * + . * * * * * * * * * * * * * * + . * * * * * * * * * * * * * * + . * * * * * * * * * * * * * * + . * * * * * * * * * * * * * * + . * * * * * * * * * * * * * * + . * * * * * * * * * * * * * * + . * * * * * * * * * * * * * * + . * * * * * * * * * * * * * * + . * * * * * * * * * * * * * * + . * * * * * * * * * * * * * * +
+ +* Triangular `applyMerge (+) [1..] [1..]` +
+ Shape + + . . . . . . . . . . . . . . * + . . . . . . . . . . . . . * * + . . . . . . . . . . . . * * * + . . . . . . . . . . . * * * * + . . . . . . . . . . * * * * * + . . . . . . . . . * * * * * * + . . . . . . . . * * * * * * * + . . . . . . . * * * * * * * * + . . . . . . . * * * * * * * * + . . . . . . * * * * * * * * * + . . . . . * * * * * * * * * * + . . . . * * * * * * * * * * * + . . . * * * * * * * * * * * * + . . * * * * * * * * * * * * * + . * * * * * * * * * * * * * * +
+ +* Skewed triangular `applyMerge (\x y -> 4 * x + y) [1..] [1..]` +
+ Shape + + . . . . . . . . . . . . . . * + . . . . . . . . . . * * * * * + . . . . . . * * * * * * * * * + . . * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * +
+ +* Hyperbolic: `applyMerge (*) [1..] [1..]` +
+ Shape + + . . . . . . . . . . . . . . . + . . . . . . . * * * * * * * * + . . . . . * * * * * * * * * * + . . . * * * * * * * * * * * * + . . . * * * * * * * * * * * * + . . * * * * * * * * * * * * * + . . * * * * * * * * * * * * * + . * * * * * * * * * * * * * * + . * * * * * * * * * * * * * * + . * * * * * * * * * * * * * * + . * * * * * * * * * * * * * * + . * * * * * * * * * * * * * * + . * * * * * * * * * * * * * * + . * * * * * * * * * * * * * * + . * * * * * * * * * * * * * * + +
+ +* Skewed hyperbolic `applyMerge (\x y -> x^3 * y) [1..]` +
+ Shape + + . . . . . . . . . . . . . . . + . . . . . . . . . . . . . . . + . . . . . . . . . * * * * * * + . . . * * * * * * * * * * * * + . . * * * * * * * * * * * * * + . * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * +
+ +* Circular: `applyMerge (\x y -> x*x + y*y) [1..]` +
+ Shape + + . . . . . . . . . . . . . * * + . . . . . . . . . . . . . * * + . . . . . . . . . . . . . * * + . . . . . . . . . . . . . * * + . . . . . . . . . . . . * * * + . . . . . . . . . . . . * * * + . . . . . . . . . . . * * * * + . . . . . . . . . . . * * * * + . . . . . . . . . . * * * * * + . . . . . . . . . * * * * * * + . . . . . . . . * * * * * * * + . . . . . . * * * * * * * * * + . . . . * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * +
+ +* Elliptical: `applyMerge (\x y -> 4*x*x + y*y) [1..]` +
+ Shape + + . . . . . . . . . . . . . . * + . . . . . . . . . . . . . * * + . . . . . . . . . . . . . * * + . . . . . . . . . . . . * * * + . . . . . . . . . . * * * * * + . . . . . . . * * * * * * * * + . . . * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * +
+ +* Composites: + + We can generate prime numbers using the Sieve of Erastosthenes: + ````haskell + primes :: [Int] + primes = 2 : ([3..] `minus` composites) -- `minus` from data-ordlist + + composites :: [Int] + composites = applyMerge (\p i -> p * (p + i)) primes [0..] + ```` + + The shape of `composites` then looks like: +
+ Shape + + . . . . . . . . . . . . . . . + . . . . . . . . . . . . . . . + . . . . . . . . . . . * * * * + . . . . * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * + * * * * * * * * * * * * * * * +
+ + Since the *n*th prime number is approximately *n* log *n*, this is a + quasi-hyperbolic shape, roughly equivalent to + + ```haskell + f :: Int -> Int -> Double + f x y = + let x' :: Double + x' = fromIntegral x + + y' :: Double + y' = fromIntegral y + + xlogx :: Double + xlogx = x' * log x' + in xlogx * (xlogx + y') + + compositesApprox :: [Double] + compositesApprox = applyMerge f [1..] [1..] + ``` diff --git a/package.yaml b/package.yaml index d761ef7..a3148fe 100644 --- a/package.yaml +++ b/package.yaml @@ -23,6 +23,7 @@ extra-doc-files: - README.md - ChangeLog.md - docs/ALGORITHM.md +- docs/Benchmark.md - LICENSES/BSD-3-Clause.txt language: GHC2021