# Perl Weekly Challenge 58: Compare Versions and Ordered Lineup
These are some answers to the Week 58 of the Perl Weekly Challenge organized by Mohammad S. Anwar.
Spoiler Alert: This weekly challenge deadline is due in a couple of days (May 3, 2020). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.
Task 1: Compare Versions
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:
v1 v2 Result
------ ------ ------
0.1 < 1.1 -1
2.0 > 1.2 1
1.2 < 1.2_5 -1
1.2.1 > 1.2_1 1
1.2.1 = 1.2.1 0
Version numbers may also contain leading zeros. You may handle these how you wish, as long as it’s consistent.
Compare Versions in Perl
Perl has two binary data comparison operators, cmp
and <=>
, which do exactly what is required. For example, cmp
returns -1, 0, or 1 depending on whether the left argument is stringwise less than, equal to, or greater than the right argument. Similarly, <=>
returns -1, 0, or 1 depending on whether the left argument is numerically less than, equal to, or greater than the right. In other words, they do exactly what we want, except of course that we have to deal with version number strings.
In my solution, the idea is to split the version string and sort the resulting arrays in such a way that if the major (first) version number makes the difference, then we are done; if not, then we compare the second version number and rank the versions accordingly; if not, we compare the third version number. We assume that versions always have at most three digits. We also assume that version “2.1” can be converted internally into “2.1.0” without any change in the ranking order.
With these assumptions, we can use the following program:
use strict;
use warnings;
use feature "say";
use Test::More tests => 5;
sub cmp_versions {
my ($v1, $v2) = @_;
s/_/.00/g for ($v1, $v2);
my @a1 = split /[._]/, $v1;
my @a2 = split /[._]/, $v2;
$a1[2] = 0 unless defined $a1[2];
$a2[2] = 0 unless defined $a2[2];
$a1[0] <=> $a2[0] || $a1[1] cmp $a2[1] || $a1[2] cmp $a2[2];
}
is cmp_versions('0.1', '1.1'), -1, "Two-part version numbers";
is cmp_versions('2.0', '1.2'), 1, "Two-part version numbers";
is cmp_versions('1.2', '1.2.5'), -1, "Two-part and three-part version numbers";
is cmp_versions('1.2.1', '1.2_1'), 1, "With underscore";
is cmp_versions('1.2.1', '1.2.1'), 0, "Three-part version numbers";
This program returns correct results for the five test cases:
$ perl cmp_versions.pl
1..5
ok 1 - Two-part version numbers
ok 2 - Two-part version numbers
ok 3 - Two-part and three-part version numbers
ok 4 - With underscore
ok 5 - Three-part version numbers
Compare Versions in Raku
Raku has a built-in Version class and type. In principle, we could just declare the version number strings as Version
objects and use the cmp
operators on them. But that wouldn’t work with version numbers with an underscore in it specified in the task description, such as 1.2_1
, as the Raku Version
class doesn’t use underscores as separators. We could probably subclass the Version
class, but that’s a bit too much work in my view for the scope of this task.
We can use the same idea as in Perl, except that in Raku, the cmp
and <=>
operators do not return -1, 0 or 1, but the values of the less
, same
or more
objects. At the same time, less
, same
or more
are just enum
values for -1, 0 or 1, as shown in this definition of Order
values:
enum Order (:Less(-1), :Same(0), :More(1));
In brief, compared to the Perl solution, we need to convert the Order
values back to their numerical equivalent. This is our solution:
use v6
use Test;
plan 5;
sub cmp-versions ($v1 is copy, $v2 is copy) {
constant %order = reverse Order.enums;
s:g/_/.00/ for $v1, $v2;
my @a1 = split /<[._]>/, $v1;
my @a2 = split /<[._]>/, $v2;
$_[2] = 0 unless defined $_[2] for @a1, @a2;
return %order{@a1[0] <=> @a2[0] || @a1[1] <=> @a2[1]
|| @a1[2] cmp @a2[2]};
}
is cmp-versions('0.1', '1.1'), -1, "Two-part version numbers";
is cmp-versions('2.0', '1.2'), 1, "Two-part version numbers";
is cmp-versions('1.2', '1.2.5'), -1, "Two-part and three-part version numbers";
is cmp-versions('1.2.1', '1.2_1'), 1, "With underscore";
is cmp-versions('1.2.1', '1.2.1'), 0, "Three-part version numbers";
The result is satisfactory:
$ perl6 cmp_versions.p6
1..5
ok 1 - Two-part version numbers
ok 2 - Two-part version numbers
ok 3 - Two-part and three-part version numbers
ok 4 - With underscore
ok 5 - Three-part version numbers
Task 2: 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.
Here is a diagram of the input arrays @H and @T:
Finally, here is one possible solution that satisfies @H and @T:
As per the last diagram, 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.)
Here’s a 64-person example, with answer provided:
# Heights
@H = (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);
# Number taller people in front
@T = ( 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);
# Expected answer
@A = (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);
You’re free to come up with your own inputs. Here is a 1000-person list, if you like!
At first, it took me a while to really understand the task. Once I understood the requirement, my first reaction was that this was going to be a quite complicated problem, with a large brute force program and a lot of backtracking.
Designing the Algorithm by Hand
To get a better idea of the task, I settled to solve the small example by hand. I found out relatively quickly that the solution can be constructed iteratively quite easily.
We have this:
@H = (2, 6, 4, 5, 1, 3) # Heights
@T = (1, 0, 2, 0, 1, 2) # Number of taller people in front
Let’s pick up the smallest height, 1. We know that there is one taller person before and, since it is the smallest one, there cannot be a smaller before. So the person with heigth 1 can only be in the second position (with index 1 in an array). So our resulting array would be, at this point:
(undef, 1)
Next, we take the second smallest, 2, which also has one taller person before. The starting idea would be to put that person in the second position, but it is already occupied by 1. We can just put that person in the next free slot, the third position. There will be a taller item in the first position and there is also a smaller item, 1, before it. So, it’s fine for now:
(undef, 1, 2)
The next smallest person is 3, and has two taller ones before. We can initially try to put in in the third position, but it’s occupied by the 2. If we try to put it in the next position (the fourth one), it would still not work, because there would be only one slot available for a taller person (the first version of the program I wrote had this mistake, because I made it too quickly). But we can place this person in the fifth position, so that we have two slots available for taller persons, and we know there cannot be any other smaller person, since all smaller persons have already been placed. So, for now, we have:
(undef, 1, 2, undef, 3)
Using the same reasoning iteratively, we can place each person so:
(undef, 1, 2, undef, 3, 4)
(5, 1, 2, undef, 3, 4)
(5, 1, 2, 6, 3, 4)
It clearly appears that there is only one solution, since each time through the process there was only one way to place a person. Assuming all heights are unique, we can conclude that for any such problem, there can be only one or zero solution.
Ordered Lineup in Perl
Once we have the algorithm, implementing it is fairly easy. The first thing we want to do is to make the link between the height and the number of taller people before in the line more robust than two parallel arrays. This is what we do with the %mapping
hash. Then we pick each height in ascending order and place it in the @result
array in accordance with the rules described above. At the end of the process, each slot of the array should be populated if there was a solution to the problem. If the problem had no solution, then some of the values in the array should be undefined. So we can just check that: if all values are defined, we just display the array; if there is one or more undefined values, then we print that the problem has no solution.
use strict;
use warnings;
use feature qw /say/;
# Heights
my @H = qw/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/;
# Number taller people in front
my @T = qw/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/;
# mapping sizes to number of taller people before
my %mapping;
@mapping{@H} = @T;
my @result;
for my $height (sort { $a <=> $b } @H) {
my $rank = $mapping{$height};
# Looking for the right slot: we start with the
# number of taller people, and add 1 for each
# defined value before the place where we will
# end up placing the current item
my $i = 0;
while ($i <= $rank) {
$rank++ if defined $result[$i++];
}
$result[$rank] = $height;
}
if (0 == grep { not defined $_ } @result) {
say "@result";
} else {
say "No solution!";
}
This produces the following output with the above input values:
$ perl ordered_line.pl
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
Changing some values to make the problem unsolvable:
$ perl ordered_line.pl
No solution
Ordered Lineup in Raku
We essentially port the Perl program to Raku:
use v6;
# Heights
my @H = < 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 >;
# Number taller people in front
my @T = < 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 >;
# mapping sizes to number of taller people before
my %mapping;
%mapping{@H} = @T;
my @result;
for @H.sort -> $height {
my $rank = %mapping{$height};
my $i = 0;
$rank++ if defined @result[$i++] while $i <= $rank;
@result[$rank] = $height;
}
say 0 == (grep { ! defined $_ }, @result).elems ?? "@result[]" !! "No solution!";
We obtain the following output:
$ perl6 ordered_line.p6
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
Wrapping up
The next week Perl Weekly Challenge is due to start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on Sunday, May 10, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.
Leave a comment