Perl Weekly Challenge 058: Compare Version and Ordered Lineup

Compare Version

Compare two given version number strings v1 and v2 such that:
  • If v1 > v2 return 1
  • If v1 < v2 return -1
  • Otherwise, return 0

The version numbers are non-empty strings containing only digits, and the dot (“.”) and underscore (“_”) characters. (“_” denotes an alpha/development version, and has a lower precedence than a dot, “.”). Here are some examples:

v1v2Result
0.1<1.1-1
2.0>1.21
1.2<1.2_5-1
1.2.1>1.2_11
1.2.1=1.2.10

When I read the task assignment, I thought to myself: I’m not the first person in the world that needs to compare versions. There already must be a module on CPAN that does exactly that. As usually, it wasn’t so simple.

In fact, there’s one module to compare versions directly in the core: version. Using it to solve the task is straightforward:

#!/usr/bin/perl
use warnings;
use strict;

use version;

sub compare_versions {
    my ($v1, $v2) = @_;
    'version'->parse($v1) <=> 'version'->parse($v2)
}

The version objects overload the comparison operator in a way that should work exactly as we need. Let’s verify it by a test suite build from the table above:

use Test::More tests => 5;

is compare_versions('0.1',   '1.1'),   -1;
is compare_versions('2.0',   '1.2'),    1;
is compare_versions('1.2',   '1.2_5'), -1;
is compare_versions('1.2.1', '1.2_1'),  1;
is compare_versions('1.2.1', '1.2.1'),  0;

Alas, the test № 4 fails. According to the module, 1.2.1 doesn’t come after 1.2_1, it isn’t the same version, either, but 1.2.1 comes before 1.2_1. The documentation claims otherwise, and there’s a bug report #118493: How to compare version objects that discusses the discrepancy among other things. But it seems the implementation is correct because it’s consistent with the way how Perl interprets versions, so 1.2_1 is in fact understood as 1.21 which is definitely greater than 1.2.1.

CPAN offers another module to work with versions: Perl::Version. It handles trial versions as described in the task (which might change in the future, because it’s inconsistent with the way how Perl does it, see above). Switching to it satisfies all the tests:

use Perl::Version;

sub compare_versions {
    my ($v1, $v2) = @_;
    'Perl::Version'->new($v1) <=> 'Perl::Version'->new($v2)
}

Ordered Lineup

Write a script to arrange people in a lineup according to how many taller people are in front of each person in line. You are given two arrays. @H is a list of unique heights, in any order. @T is a list of how many taller people are to be put in front of the corresponding person in @H. The output is the final ordering of people’s heights, or an error if there is no solution.

Here is a small example:

@H = (2, 6, 4, 5, 1, 3) # Heights
@T = (1, 0, 2, 0, 1, 2) # Number of taller people in front

The ordering of both arrays lines up, so H[i] and T[i] refer to the same person. For example, there are 2 taller people in front of the person with height 4, and there is 1 person in front of the person with height 1.

Your script would then output the ordering (5, 1, 2, 6, 3, 4) in this case. (The leftmost element is the “front” of the array.)

I needed a pen and paper to solve this which probably means we’ve moved into a more advanced phase of the challenge. In fact, when solving problems in programming competitions, using a pen and paper first is the only way for me to proceed (BTW, this weekend I participated in the Code Jam round 1C; I needed three sheets of paper, but solved only two tasks of three which gave me enough points to advance to the next round, but unfortunately, I was too slow, there were about 250 more people with the same score who finished before me).

First, I tried to line the people up starting from the smallest one. In our example, it’s the 1. They want to have one taller person in front of them—but we have just started and don’t have anyone else to place there.

So, let’s try to start with the tallest one. It’s the 6 who wants to have 0 taller people in front of them. In fact, they can’t get more than 0, as they’re the tallest one. The tallest but one is 5, they also want 0 taller people in front of them (they could have wanted 1), so we must place them in front of 6:

5 6

Now it’s 4’s turn. They want 2 taller people in front of them, so they’ll go behind the first two:

5 6 4

Three also wants 2 people, so it must go between 6 and 4:

5 6 3 4

Two wants just one taller person in front of them, so they’ll go between 5 and 6:

5 2 6 3 4

And 1 wants also just one person, so they’ll go in front of 2:

5 1 2 6 3 4

That’s the expected output! We have the algorithm, so let’s translate it to Perl. I used a temporary structure @ht which is an array representing the people, each person is represented as a pair of their height and taller people requirement:

#!/usr/bin/perl
use warnings;
use strict;

use List::UtilsBy qw{ rev_nsort_by };

sub order {
    my ($h, $t) = @_;
    my @ht = map [ $h->[$_], $t->[$_] ], 0 .. $#$h;
    my @r;
    for my $ht (rev_nsort_by { $_->[0] } @ht) {
        die "@$ht" if $ht->[1] > @r;

        my $i = my $h = 0;
        $r[$i++] > $ht->[0] and ++$h while $h < $ht->[1];
        splice @r, $i, 0, $ht->[0];
    }
    return \@r
}

use Test::More tests => 20;
use Test::Exception;

is_deeply order([2, 6, 4, 5, 1, 3],
                [1, 0, 2, 0, 1, 2]),
    [5, 1, 2, 6, 3, 4];

is_deeply order([27, 21, 37, 4, 19, 52, 23, 64, 1, 7, 51, 17, 24, 50,
                 3, 2, 34, 40, 47, 20, 8, 56, 14, 16, 42, 38, 62, 53,
                 31, 41, 55, 59, 48, 12, 32, 61, 9, 60, 46, 26, 58,
                 25, 15, 36, 11, 44, 63, 28, 5, 54, 10, 49, 57, 30,
                 29, 22, 35, 39, 45, 43, 18, 6, 13, 33],
                [6, 41, 1, 49, 38, 12, 1, 0, 58, 47, 4, 17, 26, 1, 61,
                 12, 29, 3, 4, 11, 45, 1, 32, 5, 9, 19, 1, 4, 28, 12,
                 2, 2, 13, 18, 19, 3, 4, 1, 10, 16, 4, 3, 29, 5, 49,
                 1, 1, 24, 2, 1, 38, 7, 7, 14, 35, 25, 0, 5, 4, 19,
                 10, 13, 4, 12]),
    [35, 23, 5, 64, 37, 9, 13, 25, 16, 44, 50, 40, 2, 27, 36, 6, 18,
      54, 20, 39, 56, 45, 12, 47, 17, 33, 55, 30, 26, 51, 42, 53, 49,
      41, 32, 15, 22, 60, 14, 46, 24, 59, 10, 28, 62, 38, 58, 63, 8,
      48, 4, 7, 31, 19, 61, 43, 57, 11, 1, 34, 21, 52, 29, 3];

is_deeply order([1, 2, 3], [0, 0, 0]), [1, 2, 3];
is_deeply order([1, 2, 3], [0, 1, 0]), [1, 3, 2];
is_deeply order([1, 2, 3], [1, 0, 0]), [2, 1, 3];
is_deeply order([1, 2, 3], [1, 1, 0]), [3, 1, 2];
is_deeply order([1, 2, 3], [2, 0, 0]), [2, 3, 1];
is_deeply order([1, 2, 3], [2, 1, 0]), [3, 2, 1];

throws_ok { order([1], [1]) } qr/1 1/;
throws_ok { order([1, 2], [1, 1]) } qr /2 1/;
throws_ok { order([1, 2, 3], [1, 2, 0]) } qr/2 2/;

throws_ok { order([1, 2, 3], [0, 0, 1]) } qr/3 1/;
throws_ok { order([1, 2, 3], [0, 1, 1]) } qr/3 1/;
throws_ok { order([1, 2, 3], [1, 1, 1]) } qr/3 1/;
throws_ok { order([1, 2, 3], [1, 0, 1]) } qr/3 1/;
throws_ok { order([1, 2, 3], [2, 0, 1]) } qr/3 1/;
throws_ok { order([1, 2, 3], [2, 1, 1]) } qr/3 1/;
throws_ok { order([1, 2, 3], [2, 2, 1]) } qr/3 1/;
throws_ok { order([1, 2, 3], [0, 2, 0]) } qr/2 2/;
throws_ok { order([1, 2, 3], [2, 2, 0]) } qr/2 2/;

Note that the invalid cases are correctly recognised: any time a person wants to have more taller people in front of them than available, there’s no solution. Also, if there’s no such person, there is a solution.

1 Comment

Very interesting.
Thank you.

Leave a comment

About E. Choroba

user-pic I blog about Perl.