Perl Weekly Challenge: Week 398
Challenge 1:
Divisible Average
You are given an array of positive integers.
Write a script to return the closest integer to the mean value of all even integers that are divisible by 3. If none is divisible, return 0.
Example 1
Input: @arr = (18, 5, 7, 11)
Output: 18
18 is the only even number and divisible by 3.
Average: 18 / 1 = 18.
Example 2
Input: @arr = (6, 12, 18, 24, 30, 40)
Output: 18
The qualifying numbers are 6, 12, 18, 24, and 30.
Average: (6 + 12 + 18 + 24 + 30) / 5 = 90 / 5 = 18
Example 3
Input: @arr = (3, 9, 15, 21, 27)
Output: 0
None of the elements are even.
Since no elements qualify, return 0.
Example 4
Input: @arr = (6, 12, 14, 20)
Output: 9
The qualifying numbers are 6 and 12.
Average: (6 + 12) / 2 = 9.
Example 5
Input: @arr = (6, 6, 6, 12, 12)
Output: 8
All five numbers are even and divisible by 3.
Average: (6 + 6 + 6 + 12 + 12) / 5 = 8.4 => 8
Solving this problem takes only one line in Raku.
First we alias @*ARGS, the command-line arguments, to @a for conciseness.
Then the spec wants us to find in @a even (i.e. multiples of 2) multiples of 3. Instead of
two checks, we can just look for multiples of 6 as those numbers satisfy both criteria.
If @a is not empty, we take its' average and print it, rounding to the nearest integer
if the average is not a whole number; otherwise we print 0.
my @a = @*ARGS.grep: * %% 6; say @a.elems ?? (@a.sum/@a.elems).round !! 0
The Perl version is not so simple. For starters we need our own sum(). We also need round() but instead of writing my own version, I imported it from the Math::Round module. Thus we need use Math::Round qw/ round /; at the
beginning of the script.
After we have these two functions, we can emulate the Raku version.
my @a = grep { $_ % 6 == 0 } @arr;
say scalar @a ? round(sum(@a) / scalar @a) : 0;
Challenge 2:
String Difference
You are given an array of equal length strings.
Write a script to find the difference integer array of each word in the given array. There will be one word with a different array; return that word.
Each words[i] can be converted into a difference integer array difference[i] of length n - 1 where difference[i][j] = words[i][j+1] - words[i][j]
Example 1
Input: @words = ("ab", "bc", "cd", "zy")
Output: "zy"
"ab" => [1 - 0] = [1]
"bc" => [2 - 1] = [1]
"cd" => [3 - 2] = [1]
"zy" => [24 - 25] = [-1]
Example 2
Input: @words = ("cba", "fed", "azy")
Output: "azy"
"cba" => [1 - 2, 0 - 1] = [-1, -1]
"fed" => [4 - 5, 3 - 4] = [-1, -1]
"azy" => [25 - 0, 24 - 25] = [25, -1]
Example 3
Input: @words = ("pop", "ada", "beb", "cfc")
Output: "pop"
"pop" => [14 - 15, 15 - 14] = [-1, 1]
"ada" => [3 - 0, 0 - 3] = [3, -3]
"beb" => [4 - 1, 1 - 4] = [3, -3]
"cfc" => [5 - 2, 2 - 5] = [3, -3]
Example 4
Input: @words = ("aaaa", "zzzz", "mmmm", "aaba")
Output: "aaba"
"aaaa" => [0 - 0, 0 - 0, 0 - 0] = [0, 0, 0]
"zzzz" => [25 - 25, 25 - 25, 25 - 25] = [0, 0, 0]
"mmmm" => [12 - 12, 12 - 12, 12 - 12] = [0, 0, 0]
"aaba" => [0 - 0, 1 - 0, 0 - 1] = [0, 1, -1]
Example 5
Input: @words = ("aceg", "bdfh", "cegi", "azbz")
Output: "azbz"
"aceg" => [2 - 0, 4 - 2, 6 - 4] = [2, 2, 2]
"bdfh" => [3 - 1, 5 - 3, 7 - 5] = [2, 2, 2]
"cegi" => [4 - 2, 6 - 4, 8 - 6] = [2, 2, 2]
"azbz" => [25 - 0, 1 - 25, 25 - 1] = [25, -24, 24]
We group the difference arrays for each word in a hash where the stringified array is the key and the word the value.
my %groups;
For each word...
for @words -> $word {
...we create an array of the ordinal values of each character in the word.
my @ords = $word.comb.map({ .ord });
And an array of differences between each pair of adjacent characters. This is produced by, starting from the second element to the last element, subtracting the preceding element from it.
my @difference;
for 1 .. @ords.end -> $i {
@difference.push(@ords[$i] - @crds[$i - 1]);
}
The difference array is turned into a string, the $signature.
my $signature = @difference.join(q{,});
Then if %groups hash does not have a key with that $signature, a new key
is created with an empty array as its value,
%groups{$signature} //= [];
The word is added to that key.
%groups{$signature}.push($word);
}
Once we have done this for every word, all we need to do is look through %groups...
for %groups.values -> @group {
...and find one which has exactly one element. In that case we print it out and exit the search and the script itself.
if @group.elems == 1 {
say @group[0];
last;
}
}
For Perl, we don't need any additional code. We can directly copy the Raku version.
my %groups;
for my $word (@words) {
my @ords = map { ord } split //, $word;
my @difference;
for my $i (1 .. scalar @ords - 1) {
push @difference, $ords[$i] - $ords[$i - 1];
}
my $signature = join q{,}, @difference;
$groups{$signature} //= [];
push @{$groups{$signature}}, $word;
}
for my $group (values %groups) {
if (scalar @{$group} == 1) {
say $group->[0];
last;
}
}