Merge Algorithm (Combining Sorted Lists)

[Limbic~Region]

All,
According to Wikipedia, the merge sort algorithm is for sorting a single unsorted list. The merge algorithm, which merges N sorted lists into a single sorted list is often misidentified as a merge sort (see Sort::Merge as an example). Confusing the waters even further is Algorithm::Merge which only handles 3 lists, removes duplicates indiscriminantly, and provides diffing functionality as well.

I would like to provide some input to both theorbtwo (author of Sort::Merge) and James Smith (author of Algorithm::Merge). Instead of just providing suggestions, I wanted to include code that demonstrated my improvement ideas. Unfortunately, I am currently incapable of even verifying the code compiles.

package List::Merger;
@ISA         = qw(Exporter);
@EXPORT      = qw();
@EXPORT_OK   = qw(gen_merger);

use strict;
use warnings;
use List::Util 'first';

our $VERSION = '0.01';

sub gen_merger {
    my ($list, $fetch, $compare, $finish) = @_;
    my @item = map $fetch->($_), @$list;
    
    my $done;
    return sub {
        return $finish if $done;        
        my $idx  = first {$item[$_] ne $finish} 0 .. $#item;
        my $next = $item[$idx];
        for ($idx + 1 .. $#item) {
            next if $item[$_] eq $finish;
            my $result = $compare->($next, $item[$_]);
            $next = $item[$_] if $result == 1;
        }
        $item[$idx] = $fetch->($list->[$idx]);
        $done = 1 if ! first {$item[$_] ne $finish} $idx .. $#item;
        return $next;
    };
}

An example using arrays

my $finish   = 'A val that is guaranteed not to be present in any list
+';
my @list     = (\@arr1, \@arr2, \@arr3, \@arr4, \@arr5);
my $fetch    = sub {
    my $item = shift @_;
    return $finish if ! $@item;
    return shift $@item;
};
my $compare  = sub {
    my ($item1, $item2) = @_;
    return uc($item1) cmp uc($item2);
}
my $next = gen_merger(\@list, $fetch, $compare, $finish);
while (1) {
    my $item = $next->();
    last if defined $item && $item eq $finish;
    print "$item\n";
}

An example using file handles

my $finish   = 'A val that is guaranteed not to be present in any list
+';
my @list     = ($fh1, $fh2, $fh3, $fh4, $fh5);
my $fetch    = sub {
    my $fh = shift @_;
    return $finish if eof $fh;
    return scalar <$fh>;
};
my $compare  = sub {
    my ($line1, $line2) = @_;
    my ($stamp1) = $line1 =~ /^(\d+)/;
    my ($stamp2) = $line2 =~ /^(\d+)/;
    return $stamp1 <=> $stamp2;
}
my $next = gen_merger(\@list, $fetch, $compare, $finish);
while (1) {
    my $item = $next->();
    last if defined $item && $item eq $finish;
    print "$item\n";
}

The code lacks a user defined option for handling duplicates and is likely buggy. That is not the reason for the post. The interface is cumbersome and isn't an improvement. Neither module, in my opinion, has decent real world examples and mine are contrived as well. I have failed and that's where you come in.

• What sort of interface would you like to see?
• What real problems do you have that this would solve?
• Where is the sweet spot between flexibility and a user friendly interface?
• Is this even worth worrying about?

[ikegami]

'A val that is guaranteed not to be present in any list'

ow! Please use out-of-band signaling. Safer, Simpler, Prettier.

Method 1, return value + lvalue param:

my $fetch = sub {
    my ($fh) = @_;
    return if eof $fh;
    $_[1] = scalar <$fh>;
    return 1;
};

...

while ($next->(my $item)) {
    print "$item\n";
}

Method 2, undef vs reference:

my $fetch = sub {
    my ($fh) = @_;
    return if eof $fh;
    return \(scalar <$fh>);
};

...

while (my $ref = $next->()) {  
    print "$$ref\n";
}

Method 3, empty list vs non-empty list (like each):

my $fetch = sub {
    my ($fh) = @_;
    return if eof $fh;
    return scalar <$fh>;
};

...

# RIGHT: while (my ($item) = $next->())
# WRONG: while (my $item = $next->())

while (my ($item) = $next->()) {  
    print "$item\n";
}

Update: Added second and third method.