Allow a comparison function to be passed to sorted-merge.

colomon · Dec 29, 2010 · a28cded · a28cded
1 parent cd6e59d
commit a28cded
Show file tree

Hide file tree

Showing 2 changed files with 22 additions and 2 deletions.
diff --git a/lib/List/Utils.pm b/lib/List/Utils.pm
@@ -120,15 +120,15 @@ sub upper-bound(@x, $key) is export(:DEFAULT) {
     return $first;
 }
 
-sub sorted-merge(@a, @b) is export(:DEFAULT) {
+sub sorted-merge(@a, @b, &by = &infix:<cmp>) is export(:DEFAULT) {
     my $a-list = @a.iterator.list;
     my $b-list = @b.iterator.list;
 
     my $a = $a-list.shift;
     my $b = $b-list.shift;
     gather loop {
         if $a.defined && $b.defined {
-            if $a before $b {
+            if &by($a, $b) == -1 {
                 my $temp = $a;
                 take $temp;
                 $a = $a-list.shift;

diff --git a/t/06-sorted-merge.t b/t/06-sorted-merge.t
@@ -36,5 +36,25 @@ plan *;
        "sorted-merge correct with infinite lazy lists, order swapped";
 }
 
+{
+    my @a := 1, 1, *+* ... *;
+    my @b := 3, 6 ... *;
+    is ~sorted-merge(@a, @b)[^10], ~(1, 1, 2, 3, 3, 5, 6, 8, 9, 12), 
+       "sorted-merge correct with infinite lazy lists";
+    is ~sorted-merge(@b, @a)[^10], ~(1, 1, 2, 3, 3, 5, 6, 8, 9, 12), 
+       "sorted-merge correct with infinite lazy lists, order swapped";
+}
+
+{
+    my @a := 1, * * -1/2 ... *;
+    my @b := 1, 1/3, 1/9 ... *;
+    is ~sorted-merge(@a, @b, -> $a, $b { $b.abs <=> $a.abs })[^7].perl, 
+       (1, 1, -1/2, 1/3, 1/4, -1/8, 1/9).perl, 
+       "sorted-merge correct with custom comparison";
+    is ~sorted-merge(@b, @a, -> $a, $b { $b.abs <=> $a.abs })[^7].perl, 
+       (1, 1, -1/2, 1/3, 1/4, -1/8, 1/9).perl, 
+       "sorted-merge correct with custom comparison, order swapped";
+}
+
 
 done_testing;