[#8] Add a complete benchmark suite for applyMerge

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

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)

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

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..]`
+  <details>
+    <summary>Shape</summary>
+
+      . . . . . . . . . . . . . . .
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+  </details>
+
+* Double linear: `applyMerge min [1..] [1..]`
+  <details>
+    <summary>Shape</summary>
+
+      . . . . . . . . . . . . . . .
+      . * * * * * * * * * * * * * *
+      . * * * * * * * * * * * * * *
+      . * * * * * * * * * * * * * *
+      . * * * * * * * * * * * * * *
+      . * * * * * * * * * * * * * *
+      . * * * * * * * * * * * * * *
+      . * * * * * * * * * * * * * *
+      . * * * * * * * * * * * * * *
+      . * * * * * * * * * * * * * *
+      . * * * * * * * * * * * * * *
+      . * * * * * * * * * * * * * *
+      . * * * * * * * * * * * * * *
+      . * * * * * * * * * * * * * *
+      . * * * * * * * * * * * * * *
+  </details>
+
+* Triangular `applyMerge (+) [1..] [1..]`
+  <details>
+      <summary>Shape</summary>
+
+      . . . . . . . . . . . . . . *
+      . . . . . . . . . . . . . * *
+      . . . . . . . . . . . . * * *
+      . . . . . . . . . . . * * * *
+      . . . . . . . . . . * * * * *
+      . . . . . . . . . * * * * * *
+      . . . . . . . . * * * * * * *
+      . . . . . . . * * * * * * * *
+      . . . . . . . * * * * * * * *
+      . . . . . . * * * * * * * * *
+      . . . . . * * * * * * * * * *
+      . . . . * * * * * * * * * * *
+      . . . * * * * * * * * * * * *
+      . . * * * * * * * * * * * * *
+      . * * * * * * * * * * * * * *
+  </details>
+
+* Skewed triangular `applyMerge (\x y -> 4 * x + y) [1..] [1..]`
+  <details>
+    <summary>Shape</summary>
+
+      . . . . . . . . . . . . . . *
+      . . . . . . . . . . * * * * *
+      . . . . . . * * * * * * * * *
+      . . * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+  </details>
+
+* Hyperbolic: `applyMerge (*) [1..] [1..]`
+  <details>
+    <summary>Shape</summary>
+
+      . . . . . . . . . . . . . . .
+      . . . . . . . * * * * * * * *
+      . . . . . * * * * * * * * * *
+      . . . * * * * * * * * * * * *
+      . . . * * * * * * * * * * * *
+      . . * * * * * * * * * * * * *
+      . . * * * * * * * * * * * * *
+      . * * * * * * * * * * * * * *
+      . * * * * * * * * * * * * * *
+      . * * * * * * * * * * * * * *
+      . * * * * * * * * * * * * * *
+      . * * * * * * * * * * * * * *
+      . * * * * * * * * * * * * * *
+      . * * * * * * * * * * * * * *
+      . * * * * * * * * * * * * * *
+    </summary>
+  </details>
+
+* Skewed hyperbolic `applyMerge (\x y -> x^3 * y) [1..]`
+  <details>
+    <summary>Shape</summary>
+
+      . . . . . . . . . . . . . . .
+      . . . . . . . . . . . . . . .
+      . . . . . . . . . * * * * * *
+      . . . * * * * * * * * * * * *
+      . . * * * * * * * * * * * * *
+      . * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+  </details>
+
+* Circular: `applyMerge (\x y -> x*x + y*y) [1..]`
+  <details>
+    <summary>Shape</summary>
+
+      . . . . . . . . . . . . . * *
+      . . . . . . . . . . . . . * *
+      . . . . . . . . . . . . . * *
+      . . . . . . . . . . . . . * *
+      . . . . . . . . . . . . * * *
+      . . . . . . . . . . . . * * *
+      . . . . . . . . . . . * * * *
+      . . . . . . . . . . . * * * *
+      . . . . . . . . . . * * * * *
+      . . . . . . . . . * * * * * *
+      . . . . . . . . * * * * * * *
+      . . . . . . * * * * * * * * *
+      . . . . * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+  </details>
+
+* Elliptical: `applyMerge (\x y -> 4*x*x + y*y) [1..]`
+  <details>
+    <summary>Shape</summary>
+
+      . . . . . . . . . . . . . . *
+      . . . . . . . . . . . . . * *
+      . . . . . . . . . . . . . * *
+      . . . . . . . . . . . . * * *
+      . . . . . . . . . . * * * * *
+      . . . . . . . * * * * * * * *
+      . . . * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+  </details>
+
+* 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:
+  <details>
+    <summary>Shape</summary>
+
+      . . . . . . . . . . . . . . .
+      . . . . . . . . . . . . . . .
+      . . . . . . . . . . . * * * *
+      . . . . * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+      * * * * * * * * * * * * * * *
+  </details>
+
+  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..]
+  ```

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