Perl Weekly Challenge: Week 189
Challenge 1:
Greater Character
You are given an array of characters (a..z) and a target character.
Write a script to find out the smallest character in the given array lexicographically greater than the target character.
Example 1
Input: @array = qw/e m u g/, $target = 'b'
Output: e
Example 2
Input: @array = qw/d c e f/, $target = 'a'
Output: c
Example 3
Input: @array = qw/j a r/, $target = 'o'
Output: r
Example 4
Input: @array = qw/d c a f/, $target = 'a'
Output: c
Example 5
Input: @array = qw/t g a l/, $target = 'v'
Output: v
This one was quite simple.
First we set up a variable to hold the result. It is initialized to the target just in case we fail to find an appropriate character in the array. (As in example 4.)
my $result = $target;
Then we sort the array in alphabetical order and go through it one character at a time. If we find a character larger than the target, it is the smallest such character in the array as we know because we sorted it from lexicographically least to greatest. We can stop searching...
for @array.sort -> $char {
if ($char gt $target) {
$result = $char;
last;
}
}
...and print the result.
say $result;
This is the almost identical Perl translation:
my $result = $target;
for my $char (sort @array) {
if ($char gt $target) {
$result = $char;
last;
}
}
say $result;
Challenge 2:
Array Degree
You are given an array of 2 or more non-negative integers.
Write a script to find out the smallest slice, i.e. contiguous subarray of the original array, having the degree of the given array.
The degree of an array is the maximum frequency of an element in the array.
Example 1
Input: @array = (1, 3, 3, 2)
Output: (3, 3)
The degree of the given array is 2.
The possible subarrays having the degree 2 are as below:
(3, 3)
(1, 3, 3)
(3, 3, 2)
(1, 3, 3, 2)
And the smallest of all is (3, 3).
Example 2
Input: @array = (1, 2, 1, 3)
Output: (1, 2, 1)
Example 3
Input: @array = (1, 3, 2, 1, 2)
Output: (2, 1, 2)
Example 4
Input: @array = (1, 1, 2, 3, 2)
Output: (1, 1)
Example 5
Input: @array = (2, 1, 2, 1, 1)
Output: (1, 2, 1, 1)
Now this one took a lot more effort to get right.
I started by creating a hash to hold the number of times each number occurs in the array and populated it.
my %degrees;
for @array -> $n {
%degrees{$n}++;
}
The keys of %degrees are the distinct numbers in @array and the values are the number of times
each number occurs.
So now, if we sort %degrees from most often occuring to least, the degree will be the first key.
my $degree = %degrees.keys.sort({ %degrees{$^b} <=> %degrees{$^a} }).first;
And the smallest subarray will be from the first occurrence of the degree in @array to the last.
We can find both of those with the .first() method. The first call starts searching from the beginning
of the array to its end. The second call starts at the end and searches backwards until the beginning. The
:k parameter specifies that we want the index of the occurrence not the occurrence itself.
my $start = @array.first($degree, :k);
my $end = @array.first($degree, :k, :end);
Once we have the start and end indices, we can get the subarray with an array slice. (The rest of the line is just some formatting to make the output look like that in the spec.)
say q{(} ~ @array[$start .. $end].join(q{, }) ~ q{)};
Unfortunately, this was completely wrong.
Take Example 4 for instance. Sometimes my code will give the right answer but randomly (due to hash randomization) it will give the result (2, 3, 2). This is because in that example, both 1 and 2 occur the same amount of
times and I did not account for more than one highest value. Also there is a logical error in $degree. It is
the key which occurs most often but actually it should be the number of times the most frequent key occurs. (i.e. its' value.)
So I tried again. The population of %degrees remains the same.
my %degrees;
for @array -> $n {
%degrees{$n}++;
}
But now $degree is calculated properly.
my $degree = %degrees{%degrees.keys.sort({ %degrees{$^b} <=> %degrees{$^a} }).first};
There is now an array so we can hold multiple candidate subarrays.
my @results;
For each key whose occurrence is equal to the degree...
for %degrees.keys.grep({ %degrees{$_} == $degree }) -> $key {
...we find the start and end using the same technique as the old version.
my $start = @array.first($key, :k);
my $end = @array.first($key, :k, :end);
But this time, we add the subarray into @results.
@results.push(@array[$start .. $end]);
}
And when we have all possible subarrays, we sort @result to find the shortest one and pretty print it.
say q{(} ~ @results.sort({$^a.elems <=> $^b.elems }).first.join(q{, }) ~ q{)};
This is the Perl version. The calculation of %degrees and $degree remains virtually the same.
for my $n (@array) {
$degrees{$n}++;
}
my $degree = $degrees{(sort { $degrees{$b} <=> $degrees{$a} } keys %degrees)[0] };
my @results;
for my $key (grep { $degrees{$_} == $degree } keys %degrees) {
Because we don't have .first() in Perl I had to think of another way to find the start
and end of a subarray. I thought index() and rindex() would be ideal but, alas!, they
only work on strings. Hence this more complicated code:
my $start = -1;
my $end = -1;
for my $i (0 .. scalar @array - 1) {
if ($array[$i] == $key) {
if ($start == -1) {
$start = $i;
} else {
$end = $i;
}
}
}
Be that as it may, we end up with $start and $end and we use them to add an array slice to @results.
push @results, [ @array[$start .. $end] ];
}
Working with array references in Perl is a pain. I had to split up the final line of the Raku version into two lines of Perl to get it working right.
my @sorted = sort { @{$a} <=> @{$b} } @results;
say q{(} . (join q{, }, @{ shift @sorted }) . q{)};