Perl Weekly Challenge: Week 196
I am writing this from Indira Gandhi International Airport, New Delhi, India waiting for my connecting flight to my hometown of Rajkot in Gujarat. I'm going for a much needed two week holiday with my family. Unfortunately last minute preparation for this trip played havoc with my Advent of Code attempts and I've essentially given up for now. I'll try and finish after I get back. I must say however that using Raku to solve the puzzles has been a dream. I have also done some of the days in Kotlin and it is more verbose and a lot less versatile in comparison.
Challenge 1:
Pattern 132
You are given a list of integers,
@list.Write a script to find out subsequence that respect
Pattern 132. Return empty array if none found.Pattern 132 in a sequence (a[i], a[j], a[k]) such that
i < j < k and a[i] < a[k] < a[j].
Example 1
Input: @list = (3, 1, 4, 2)
Output: (1, 4, 2) respect the Pattern 132.
Example 2
Input: @list = (1, 2, 3, 4)
Output: () since no susbsequence can be found.
Example 3
Input: @list = (1, 3, 2, 4, 6, 5)
Output: (1, 3, 2) if more than one subsequence found then return the first.
Example 4
Input: @list = (1, 3, 4, 2)
Output: (1, 3, 2)
Any time your code has three nested for loops, it's a warning sign that your algorithm might not be the best but I didn't have a lot of time to work on this problem and this solution works so here we are.
The outermost loop goes from the first element to two before the last element because the we need three elements for the answer and going any further would run past the end of the list.
for 0 .. @list.end - 2 -> $i {
The next loop goes from the element after @list[$i] upto one before the last element...
for $i ^.. @list.end - 1 -> $j {
...and the innermost goes from the element after @list[$j] upto the last element.
for $j ^.. @list.end -> $k {
You may be wondering why I didn't just use one loop and make $j = @list[$i + 1] and $k = @list[$i + 2].
The reason is that the spec doesn't require $i, $j and $k to be consequitive only in increasing order. Example 4 illustrates this case.
Now we have values for $i, $j and $k and we know that $i < $j < $k, we can test the second requirement;
whether @list[$i] < @list[$k] < @list[$j].
if @list[$i] < @list[$k] && @list[$k] < @list[$j] {
If this is true, we can output the subsequence in the format used in the examples and stop the script. (There may possibly be other eligible subsequences but we only care about the first.)
say "({(@list[$i], @list[$j], @list[$k]).join(q{, })})";
exit;
}
}
}
}
If we make it through all three loops, it means we did not find a valid subsequnce so we can output an empty array.
say '()';
This is the Perl version. It works exactly the same way as in Raku.
for my $i (0 .. scalar @list - 3) {
for my $j ($i + 1 .. scalar @list - 2) {
for my $k ($j + 1 .. scalar @list - 1) {
if ($list[$i] < $list[$k] && $list[$k] < $list[$j]) {
say q{(}, (join q{, }, ($list[$i], $list[$j], $list[$k])), q{)};
exit;
}
}
}
}
say q{()};
Challenge 2:
Range List
You are given a sorted unique integer array,
@array.Write a script to find all possible
Number Rangei.e [x, y] represent range all integers fromxandy(both inclusive).Each subsequence of two or more contiguous integers
Example 1
Input: @array = (1,3,4,5,7)
Output: [3,5]
Example 2
Input: @array = (1,2,3,6,7,9)
Output: [1,3], [6,7]
Example 3
Input: @array = (0,1,2,4,5,6,8,9)
Output: [0,2], [4,6], [8,9]
This one also involved traversing a list.
First I set up a variable to store all the number ranges I might find.
my @allranges;
And one to hold the index of the element in the array that is to be the potential start of a range. Naturally, we begin from the 0th element.
my $n = 0;
Now as long as we have not reached the end of the array...
while $n < @array.end {
$r is the current element in a range. It starts off equal to $n.
my $r = $n;
A list is created to hold the range. $r becomes its' first element.
my @range = ( @array[$r] );
We iterate through the array until at most we reach the end though in most cases we will probably stop before then.
until $r == @array.end {
$r++;
If the value of the current element (i.e. $r) is 1 more than the element before it,
it is part of the range so we add it.
if @array[$r] - @array[$r - 1] == 1 {
@range.push(@array[$r]);
If not, we are at the end of the range so we can stop the iteration.
} else {
last;
}
}
$n is set to the current value of $r. This line is necessary because otherwise you
get overalapping ranges. For instance in example 1, without this line I got [3,4,5] and [4,5]
even though the latter is entirely contained in the former.
$n = $r;
The range we found is added to @allranges.
@allranges.push(@range);
And then we do the whole thing again for the next range until the end of @array has been reached.
}
The output shown in the examples shows that only the beginning and end of each range should be displayed.
So using map() we transform each range into the required format. This also implies that each range should have
atleast two elemens so beforehand, we use grep() to filter out any one-element ranges.
@allranges = @allranges.grep({ @$_.elems > 1 }).map({ "[{@$_[0]},{@$_[*-1]}]"; });
say @allranges.join(q{, });
This is the Perl version. Once again, it is a straight translation from Raku.
my @allranges;
my $n = 0;
while ($n < scalar @array - 1) {
my $r = $n;
my @range = ( $array[$r] );
until ($r == scalar @array - 1) {
$r++;
if ($array[$r] - $array[$r - 1] == 1) {
push @range, $array[$r];
} else {
last;
}
}
$n = $r;
push @allranges, \@range;
}
@allranges = map { "[$_->[0],$_->[-1]]"; } grep { scalar @{$_} > 1 } @allranges;
say join q{, }, @allranges;
Merry Christmas to all who celebrate it. During my travels I most likely will be in places without good Internet connectivity so I'll probably miss the next two weeks. If so, see you all in the new year!