PWC 343 › It’s hard to make friends when you’re a zero

This post is part of a series on Mohammad Anwar’s excellent Weekly Challenge, where hackers submit solutions in Perl, Raku, or any other language, to two different challenges every week. (It’s a lot of fun, if you’re into that sort of thing.)

This week’s challenge has two easy tasks.

Task 1: Zero Friend

For the first task this week, you’re given a list of numbers and simply have to return the number that is closest to zero. Core module List::Util helps us here.

sub zero_friend { min map abs, @_ }

There isn’t much explanation to be offered, here. We first map our list of arguments (@_) to their absolute values, and then return the minimum of that.

Task 2: Champion Team

For this one, we’re given a matrix of tournament match results. Each row contains a team, and the columns contain that team’s results vs. every other team. Notably, many of the examples don’t have a symmetric matrix as you would expect from a typical round-robin style of competition, but let’s roll with it anyway. For example:

       ([0, 1, 0, 0], # Index 0, Score 1
        [0, 0, 0, 0], #       1        0
        [1, 1, 0, 0], #       2        2
        [1, 1, 1, 1]) #       3        4

The team at index 3 has the highest score (4 wins), so given the above, we’d return 3.

In the event of a tie, I will take the decidedly unfair convention that the team with the lowest index will walk away with the championship. A better idea might have been to return all winners, but that’s not the job.

There are many ways to solve this one. One solution that performs well and is quite compact uses a loop with List::Util::sum():

sub best {
    my ($bs,$bi,$s) = (0,0);
    ($s = sum $_[$_]->@*) > $bs and ($bs,$bi)=($s,$_) for 0..$#_;
    $bi;
}

We remember the best sum and index ($bs, $bi), and the current $score (or sum, if you like). It’s a simple loop over the indices of @_ (keys @_ works equally well, here). Then I use sum to add up all the values for the current row. (sum turns out to be both more compact and more performant than, say, scalar grep { $_ }). And if the sum is better than the current best, replace the best sum and best index with the current sum and index.

That’s the core of all of the solutions I came up with. It’s linear on the number of games played (or O(n2) on the number of teams), which is the best you can do.

Alternatives

Here are a few other equivalent solutions:

sub reduce1 {
    (reduce { $a->[1] > $b->[1] ? $a : $b }
        map { [   $_ => sum $_[$_]->@*  ] } keys @_)->[0];
}

sub reduce2 {
    my @teams = map { sum @$_ } @_;
    reduce { $teams[$a] > $teams[$b] ? $a : $b } keys @_;
}

reduce is extremely powerful (and many other list operations can be written with reduce instead).

sub hash_ {
    my %vals = map { sum($_[$_]->@*) => $_ } keys @_;
    $vals{ max keys %vals }
}

Perl hashes are fast, but this code doesn’t take advantage of their strengths. It was the worst performer of the bunch by a fair margin (about 40%).

sub loop {
    my @best = (0,0);
    for (keys @_) {
        my $sum = sum $_[$_]->@*;
        @best = ($sum, $_) if $sum > $best[0];
    }
    $best[1];
}

This one is similar in structure to the main (first) solution. The main solution was 37% faster. I was surprised that the difference was so high. My initial hypothesis was that the lexical $sub might have explained it. However, I profiled it in more detail and found:

  • The lexical $sub contributed about 7% of that 37%.
  • Using keys @_ instead of 0..$#_ accounts for about 27%!
  • Finally, using @best instead of two separate variables is a minor contributor at ~2%.

Benchmarking

Now that we have the superheroes of the List Cinematic Universe assembled, we may as well drag race them!

             Rate    hash reduce2 reduce1    loop   final
hash     694364/s      --    -40%    -44%    -56%    -68%
reduce2 1154616/s     66%      --     -8%    -28%    -47%
reduce1 1250057/s     80%      8%      --    -22%    -43%
loop    1592576/s    129%     38%     27%      --    -27%
best    2182224/s    214%     89%     75%     37%      --

Run perl ch-2a.pl --bench to try these on your own system.

Leave a Reply

Your email address will not be published. Required fields are marked *