Add tests for applyMergeOn

apply-merge.cabal

@@ -61,6 +61,7 @@ test-suite apply-merge-tests
       Test.ApplyMerge.IntMap
       Test.ApplyMerge.IntSet
       Test.Data.DoublyLinkedList.STRef
+      Test.Data.List.ApplyMerge
       Test.Data.PQueue.Prio.Min.Mutable
   hs-source-dirs:
       src

test/Main.hs

@@ -8,6 +8,7 @@ import Test.ApplyMerge.IntMap qualified (tests)
 import Test.ApplyMerge.IntSet qualified (tests)
 import Test.Data.DoublyLinkedList.STRef qualified (tests)
 import Test.Data.PQueue.Prio.Min.Mutable qualified (tests)
+import Test.Data.List.ApplyMerge qualified (tests)
 import Test.Tasty (TestTree, defaultMain, testGroup)
 
 main :: IO ()
@@ -20,6 +21,7 @@ tests =
     [ Test.ApplyMerge.DoublyLinkedList.tests,
       Test.ApplyMerge.IntMap.tests,
       Test.ApplyMerge.IntSet.tests,
+      Test.Data.List.ApplyMerge.tests,
       Test.Data.DoublyLinkedList.STRef.tests,
       Test.Data.PQueue.Prio.Min.Mutable.tests
     ]

test/Test/Data/List/ApplyMerge.hs

@@ -0,0 +1,52 @@
+-- SPDX-FileCopyrightText: Copyright Preetham Gujjula
+-- SPDX-License-Identifier: BSD-3-Clause
+module Test.Data.List.ApplyMerge (tests) where
+
+import Data.Complex (Complex ((:+)))
+import Data.List (sortOn)
+import Data.List.ApplyMerge (applyMergeOn)
+import Data.Ratio ((%))
+import Test.ApplyMerge.Common (basicTest, blockTest, maxTest, skewedTest)
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit (testCase, (@?=))
+
+tests :: TestTree
+tests =
+  testGroup
+    "Data.List.ApplyMerge.applyMergeOn"
+    [ basicTest (applyMergeOn id),
+      skewedTest (applyMergeOn id),
+      blockTest (applyMergeOn id),
+      maxTest (applyMergeOn id),
+      gaussianIntegerTest
+    ]
+
+gaussianIntegerTest :: TestTree
+gaussianIntegerTest =
+  testCase "gaussian integers x + yi, with 0 <= x <= y, ordered by norm" $ do
+    let actual =
+          take 100 $
+            applyMergeOn
+              (\x -> (norm x, slope x))
+              (\x k -> x :+ (x + k))
+              [0 ..]
+              [0 ..]
+        expected =
+          take 100 $
+            filter (\(x :+ y) -> x <= y) $
+              sortOn
+                (\x -> (norm x, slope x))
+                (liftA2 (:+) [0 .. 100] [0 .. 100])
+     in actual @?= expected
+
+norm :: Complex Integer -> Integer
+norm (a :+ b) = a * a + b * b
+
+data Slope = Finite Rational | Infinity
+  deriving (Eq, Show, Ord)
+
+slope :: Complex Integer -> Slope
+slope (x :+ y) =
+  if x == 0
+    then Infinity
+    else Finite (y % x)