perlmeditation
tobyink
<p><a href="http://www.perlmonks.org/?node=thezip">An esteemed monk</a> last night mentioned a problem of sorting a list of people alphabetically, but so that people with a job title of "Manager" are floated to the top of the list. I'm sure we can all think of similar problems we've had. For instance, sorting task/todo items by date, but sorting high priority tasks first.</p>
<p>Anyhow, it was late and I mumbled something about <c>part</c> from [mod://List::MoreUtils] and wondered off to the monastery sleeping quarters.</p>
<p>Here I'd like to compare three implementations. Firstly, the naive approach:</p>
<code>
my @sorted = sort {
if ($a->title =~ /Manager/ and not $b->title =~ /Manager/) {
-1;
}
elsif ($b->title =~ /Manager/ and not $a->title =~ /Manager/) {
1;
}
else {
$a->name cmp $b->name;
}
} @employees;
</code>
<p>If A is a manager but not B, then A goes first. If B is a manager, but not A, then B goes first. Otherwise (both are managers, or neither are managers), then sort by name. Simple; easy to understand.</p>
<p>But what are the drawbacks? The regexp is used four times, resulting in a lot of duplication. OK, so we could say <c>my $test = qr/Manager/</c> and stop repeating ourselves, but even so, the regexp is still being matched against quite a lot. In the case where A and B are both managers, the regexp is matched against four times within the block. And that happens for each pair of people compared.</p>
<p>OK, so actually we can use the return value of <c>=~</c> (or <c>!~</c>) numerically and turn that to our advantage. A slightly subtler approach...</p>
<code>
my @sorted = sort {
($a->title !~ /Manager/) - ($b->title !~ /Manager/)
or $a->name cmp $b->name;
} @employees;
</code>
<p>Here the regexp match happens only twice within the block, which should improve the efficiency of the sorting.</p>
<p>Now let's take a look at what I was jabbering on about last night; using <c>part</c> to split the list into a list of managers and a list of non-managers. That way we can sort the lists separately just based on their names (quick and easy) and then join them together again.</p>
<code>
use List::MoreUtils qw( part );
my @sorted =
map { sort { $a->name cmp $b->name } @$_ }
part { $_->title !~ /Manager/ }
@employees;
</code>
<p>It's perhaps a little less readable than the first, naive approach, but it has some nice features. The <c>/Manager/</c> regexp isn't repeated, and is only matched once for each person.</p>
<p>For those who are interested, here's a Test::More script that proves all three approaches work...</p>
<readmore>
<code>
use v5.14;
use strict;
use warnings;
use Test::More;
package Person {
use Moo;
has name => (is => 'ro');
has title => (is => 'ro');
}
sub Person {
my ($name, $title) = @_;
Person::->new(name => $name, title => $title);
}
my @employees = (
Person("Eve", "Tech Support"),
Person("Alice", "Sales Manager"),
Person("Dave", "Janitor"),
Person("Fred", "Receptionist"),
Person("Bob", "Customer Services"),
Person("Greg", "Finance Manager"),
Person("Carol", "Marketing Manager"),
);
my @correct = (
Person("Alice", "Sales Manager"),
Person("Carol", "Marketing Manager"),
Person("Greg", "Finance Manager"),
Person("Bob", "Customer Services"),
Person("Dave", "Janitor"),
Person("Eve", "Tech Support"),
Person("Fred", "Receptionist"),
);
OBVIOUS_APPROACH: {
my @sorted = sort {
if ($a->title =~ /Manager/ and not $b->title =~ /Manager/) {
-1;
}
elsif ($b->title =~ /Manager/ and not $a->title =~ /Manager/) {
1;
}
else {
$a->name cmp $b->name;
}
} @employees;
is_deeply(\@sorted, \@correct, 'Obvious approach');
}
SUBTLER_APPROACH: {
my @sorted = sort {
($a->title !~ /Manager/) - ($b->title !~ /Manager/)
or $a->name cmp $b->name;
} @employees;
is_deeply(\@sorted, \@correct, 'Subtler approach');
}
FUNCTIONAL_APPROACH: {
use List::MoreUtils qw( part );
my @sorted =
map { sort { $a->name cmp $b->name } @$_ }
part { $_->title !~ /Manager/ }
@employees;
is_deeply(\@sorted, \@correct, 'Functional approach');
}
done_testing();
</code>
</readmore>
<p>Now as I've hinted; my gut feeling was that the final, functional approach should be faster. This is for two reasons:</p>
<ul>
<li>The regexp match happens fewer times. Our regexp is pretty simple, but imagine we also needed to classify Directors as Managers; and the Chief Executive too. The regexp could quickly become more complicated.</li>
<li>The Perl sorting algorithm is <i>O(N log N)</i> which means that it's quicker to sort two lists of lengths <i>a</i> and <i>b</i> than it is to sort a single combined list of length <i>a+b</i>.</li>
</ul>
<p>How much faster... well, I generated a random list of 200 employees with numeric names, and a random job title of either "Manager" or "Staff", and ran the results though [mod://Benchmark]...</p>
<readmore>
<code>
use v5.14;
use strict;
use warnings;
use List::MoreUtils qw( part );
use Benchmark ':all';
package Person {
use Moo;
has name => (is => 'ro');
has title => (is => 'ro');
}
my @employees = map {
Person::->new(
name => int(rand(999999)),
title => int(rand(2))?'Staff':'Manager',
)
} 0..200;
sub obvious {
my @sorted = sort {
if ($a->title =~ /Manager/ and not $b->title =~ /Manager/) {
-1;
}
elsif ($b->title =~ /Manager/ and not $a->title =~ /Manager/) {
1;
}
else {
$a->name cmp $b->name;
}
} @employees;
}
sub subtle {
my @sorted = sort {
($a->title !~ /Manager/) - ($b->title !~ /Manager/)
or $a->name cmp $b->name;
} @employees;
}
sub functional {
my @sorted =
map { sort { $a->name cmp $b->name } @$_ }
part { $_->title !~ /Manager/ }
@employees;
}
cmpthese(1000, {
obvious => \&obvious,
subtle => \&subtle,
functional => \&functional,
});
</code>
</readmore>
<p>The results were impresssive...</p>
<pre>
Rate obvious subtle functional
obvious 102/s -- -26% -70%
subtle 137/s 34% -- -59%
functional 336/s 228% 144% --
</pre>
<p>That's right; the functional approach shaves off 70% of the time taken to sort the list of employees!</p>
<p>So remember, for prioritised sorting, <c>part</c> is your friend!</p>
<p><b>UPDATE:</b>, using [mod://Sort::Key]'s <c>keysort</c> in conjunction with the functional approach doubles its speed once again!</p>
<code>
my @sorted =
map { keysort { $_->name } @$_ }
part { $_->title !~ /Manager/ }
@employees;
</code>
<p><c>keysort</c> is an XS implementation of the Schwartzian transform.</p>
<!-- Node text goes above. Div tags should contain sig only -->
<div class="pmsig"><div class="pmsig-757127">
<small><small>
<tt>perl -E'sub Monkey::do{say$_,for@_,do{($monkey=[caller(0)]->[3])=~s{::}{ }and$monkey}}"Monkey say"->Monkey::do'
</tt></small></small>
</div></div>