### Merge Algorithm (Combining Sorted Lists)

by Limbic~Region (Chancellor)
 on Dec 06, 2006 at 19:17 UTC Need Help??
Limbic~Region has asked for the wisdom of the Perl Monks concerning the following question:

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?

Cheers - L~R

Replies are listed 'Best First'.
Re: Merge Algorithm (Combining Sorted Lists)
by ikegami (Pope) on Dec 06, 2006 at 19:27 UTC

'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.

Create A New User
Node Status?
node history
Node Type: perlquestion [id://588159]
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (5)
As of 2018-05-23 07:55 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
World peace can best be achieved by:

Results (166 votes). Check out past polls.

Notices?