Perl Weekly Challenge: Week 50
Challenge 1:
Merge Intervals
Write a script to merge the given intervals where ever possible.
[2,7], [3,9], [10,12], [15,19], [18,22]The script should merge [2, 7] and [3, 9] together to return [2, 9].
Similarly it should also merge [15, 19] and [18, 22] together to return [15, 22].
The final result should be something like below:
[2, 9], [10, 12], [15, 22]
I chose to allow entering input on the command line in the format described above. So the first thing to do is to parse the command line arguments. This is the Perl version of my code.
I used a regular expression to get the numbers in each interval and saved them
as a reference to a two-element array in an array called @intervals.
my @intervals;
for my $arg (@ARGV) {
$arg =~ /\[ (\d+) , (\d+) \] ,?/gmx;
push @intervals, [$1, $2];
}
The size of @intervals will be useful later on.
my $size = scalar @intervals;
You don't often see an old c-style for loop in Perl but occasionally they are
useful especially when you have to count which element of an array you are processing.
@merged as the name suggests, will hold our merged intervals.
my @merged;
for (my $i = 0; $i < $size - 1; $i++) {
For each interval, the first element is the beginning of the range and the second element is the end.
my $start = $intervals[$i]->[0];
my $end = $intervals[$i]->[1];
We also look at the next interval. If the end of the current interval is within the
next interval, the end of the current interval is extended to the end of that one
effectively merging the two. This is within a while loop because, although the
example in the task description doesn't exhibit it, it is possible that three or more
intervals may have to be merged. So the test in the while statement also has to
check we don't go beyond the bounds of the array.
while ($i < $size - 1 &&
$end >= $intervals[$i + 1]->[0] && $end <= $intervals[$i + 1]->[1]) {
$end = $intervals[$i + 1]->[1];
$i++;
}
And then we add the result to @merged. This could be a merged interval or the
original one if no merging occurred.
push @merged, [$start, $end];
}
Finally the intervals that remain are printed.
say join ', ', map { "[$_->[0],$_->[1]]" } @merged;
This is my Raku version. One of the great things about Raku is that it has a
much richer set of data type. Here for example, instead of two-element arrays,
@intervals consists of Ranges. This is a much more natural fit for the kind
of data an interval is.
$arg ~~ / \[ $<min> = (\d+) \, $<max> = (\d+) \] \,? /;
@intervals.push($/<min> .. $/<max>);
BTW, instead of overloading the for keyword, Raku uses loop for c-style for loops.
loop (my $i = 0; $i < $size - 1; $i++) {
Back to Ranges. Instead of the cryptic [0] and [1] we can use the more
intuitive .min() and .max().
my $start = @intervals[$i].min();
my $end = @intervals[$i].max();
And checking if $end is within an interval is super simple with the 'smart match'
or ~~ operator.
while $i < $size - 1 && $end ~~ @intervals[$i + 1] {
$end = @intervals[$i + 1].max();
$i++;
}
Challenge 2:
Noble Integer
You are given a list,
@L, of three or more random integers between 1 and 50. A Noble Integer is an integer N in@L, such that there are exactly N integers greater than N in @L. Output any Noble Integer found in@L, or an empty list if none were found.An interesting question is whether or not there can be multiple Noble Integers in a list.
For example,
Suppose we have list of 4 integers [2, 6, 1, 3].
Here we have 2 in the above list, known as Noble Integer, since there are exactly 2 integers in the list i.e. 3 and 6, which are greater than 2.
Therefore the script would print 2
This one was so easy I had to re-read the problem a couple of times to make sure I wasn't missing something.
This is the Perl version. I get the list as a series of command line arguments. As we will need to determine with elements are greater than N it makes sense to sort the array by magnitude. We also need the size of the list.
my @L = sort @ARGV;
my $size = scalar @L;
Now we go through the list via an old-style for loop. If there are size - N - 1
list elements after LN (the list is sorted remember) we know N is
a Noble Integer.
for (my $n = 0; $n < $size; $n++) {
if ($L[$n] == $size - $n - 1) {
say $L[$n];
}
}
The Raku version works the same way.
multi sub MAIN(*@ARGS) {
my @L = @*ARGS.sort;
my $size = @L.elems;
loop (my $n = 0; $n < $size; $n++) {
if (@L[$n] == $size - $n - 1) {
say @L[$n];
}
}
}
As to the question asked in the task description, I think it is impossible for there to be more than one Noble Integer in a list but it isn't something I can prove.