Perl Weekly Challenge: Week 371
Challenge 1:
Missing Letter
You are given a sequence of 5 lowercase letters, with one letter replaced by ‘?’. Each letter maps to its position in the alphabet (‘a = 1’, ‘b = 2’, …, ‘z = 26’). The sequence follows a repeating pattern of step sizes between consecutive letters. The pattern is either a constant step (e.g., ‘+2, +2, +2, +2’) or a simple alternating pattern of two distinct steps (e.g., ‘+2, +3, +2, +3’).
[Note: this is how the problem was given but it seems a part of it is missing.]
Example 1
Input: @seq = qw(a c ? g i)
Output: e
The pattern of the sequence is +2,+2,+2,+2.
1: a
3: c
5: e
7: g
9: i
Example 2
Input: @seq = qw(a d ? j m)
Output: g
The pattern of the sequence is +3,+3,+3,+3.
1: a
4: d
7: g
10: j
13: m
Example 3
Input: @seq = qw(a e ? m q)
Output: i
The pattern of the sequence is +4,+4,+4,+4.
1: a
5: e
9: i
13: m
17: q
Example 4
Input: @seq = qw(a c f ? k)
Output: h
The pattern of the sequence is +2,+3,+2,+3.
1: a
3: c
6: f
8: h
11: k
Example 5
Input: @seq = qw(b e g ? l)
Output: j
The pattern of the sequence is +3,+2,+3,+2.
2: b
5: e
7: g
10: j
12: l
The contents of the MAIN() method are miniscule; we just call the findMissing()
funtion and print its' results.
say findMissing(@seq);
findMissing() takes the letters in @seq as parameters.
sub findMissing(@seq) {
Because we will want to change ? to some other letter and @seq is immutable,
we make a copy of it called @chars.
my @chars = @seq;
First, we have to find the postion of ? within @chars/@seq. We declare a variable
$unknownPos and initialize it to -1, an "impossible" position.
my $unknownPos = -1;
for @chars.keys -> $pos {
if @chars[$pos] eq '?' {
$unknownPos = $pos;
last;
}
}
Although this is not an issue in the examples, as a matter of defensive programming
we should allow for the possibility that there is no ? in the sequence. If this
is the case $unknownPos will still equal -1. The spec does not say what to do
if there is no ? so I have arbitrarily chosen to return ?. I think this is distinctive
enough to show that something went wrong.
if $unknownPos == -1 {
return '?';
}
Otherwise we replace ? with another character. There might be a more elegant
way of doing this but the spec tells us the missing character is a lower case letter
and there are only 26 of those which is a small enough amount that we can use "brute force"
and just try them all one by one.
for 'a' .. 'z' -> $letter {
We place the current letter in the unknown position of @chars.
@chars[$unknownPos] = $letter;
Then we use the isValidSequence() function decribed later to determine if we got the
right letter or not. If we did, we return it.
if isValidSequence(@chars) {
return $letter;
}
}
Because we have already tested to make sure there is a ?, we should never actually
reach here but for completeness' sake we return ? here.
return '?';
}
The last function we need is isValidSequence() whose name is self-explanatory.
It will return True if its' parameter @seq is valid or False if it is not.
sub isValidSequence(@seq) {
We determine the validity of a sequence by the way the positions of its' character
elements advance. So first we have to convert the letters to positions. `
is the character before a so subtracting the ASCII value of a lower-case letter (found with
.ord()) from its' ASCII value gives a position value of 1 (for a) to 26 (for z).
my @positions = @seq.map({ $_.ord - "`".ord });
Then we calculate step differences between consecutive letters. As there are five letters in the sequence there will only be 4 differences.
my @steps = (0 .. 3).map({ @positions[$_ + 1] - @positions[$_] });
Two types of step patterns are valid.
If the steps advance at a constant rate (i.e. all the elements in
@stepsare the same)if @steps.all == @steps[0] { return True; }if the steps alternate between two values. We can check this by seeing if the first and the third elements in
@stepsare equal and if the second and fourth elements are equal.if @steps[0] == @steps[2] && @steps[1] == @steps[3] { return True; }
If either of these conditions were met, we return True. Otherwise we return False.
return False;
}
The translation from Raku to Perl was very simple and no extra functions were needed.
sub isValidSequence(@seq) {
my @positions = map { ord($_) - ord(q{`}) } @seq;
my @steps = map { $positions[$_ + 1] - $positions[$_] } 0 .. 3;
The lack of .all() did require me to write this test differently though.
unless (grep { $_ == $steps[0] } @steps) {
return true;
}
if ($steps[0] == $steps[2] && $steps[1] == $steps[3]) {
return true;
}
return false;
}
sub findMissing(@seq) {
my @chars = @seq;
my $unknownPos = -1;
for my $pos (keys @chars) {
if ($chars[$pos] eq '?') {
$unknownPos = $pos;
last;
}
}
if ($unknownPos == -1) {
return '?';
}
for my $letter ('a' .. 'z') {
$chars[$unknownPos] = $letter;
if (isValidSequence(@chars)) {
return $letter;
}
}
return '?';
}
say findMissing(@ARGV);
Challenge 2:
Subset Equilibrium
You are given an array of numbers.
Write a script to find all proper subsets with more than one element where the sum of elements equals the sum of their indices.
Example 1
Input: @nums = (2, 1, 4, 3)
Output: (2, 1), (1, 4), (4, 3), (2, 3)
Subset 1: (2, 1)
Values: 2 + 1 = 3
Positions: 1 + 2 = 3
Subset 2: (1, 4)
Values: 1 + 4 = 5
Positions: 2 + 3 = 5
Subset 3: (4, 3)
Values: 4 + 3 = 7
Positions: 3 + 4 = 7
Subset 4: (2, 3)
Values: 2 + 3 = 5
Positions: 1 + 4 = 5
Example 2
Input: @nums = (3, 0, 3, 0)
Output: (3, 0), (3, 0, 3)
Subset 1: (3, 0)
Values: 3 + 0 = 3
Positions: 1 + 2 = 3
Subset 2: (3, 0, 3)
Values: 3 + 0 + 3 = 6
Positions: 1 + 2 + 3 = 6
Example 3
Input: @nums = (5, 1, 1, 1)
Output: (5, 1, 1)
Subset 1: (5, 1, 1)
Values: 5 + 1 + 1 = 7
Positions: 1 + 2 + 4 = 7
Example 4
Input: @nums = (3, -1, 4, 2)
Output: (3, 2), (3, -1, 4)
Subset 1: (3, 2)
Values: 3 + 2 = 5
Positions: 1 + 4 = 5
Subset 2: (3, -1, 4)
Values: 3 + (-1) + 4 = 6
Positions: 1 + 2 + 3 = 6
Example 5
Input: @nums = (10, 20, 30, 40)
Output: ()
We declare some storage for the results.
my @results;
In order to solve this challenge, we are going to have to know the index or position of
each number. We can get this using .keys() and store it for later use in a list @indices.
my @indices = @nums.keys;
Raku's .combinations() method let's us easily get all the subsets of @nums. But
it will actually be more convenient if we work on subsets of @indices because mapping
an index from an element is potentially more difficult than mapping an element from an
index (several elements could have the same value for instance.)
for @indices.combinations(2 ..^ @indices.elems) -> @combo {
In fact, recreating a subset of elements from a subset of indices is just a simple .map().
my @subset = @combo.map({ @nums[$_] });
But we can't just compare the sum of the element subset to the sum of the index subset. Although the spec doesn't explicitly say it, looking at the examples we can see that it is assuming indices are 1-based whereas what we have is actually 0-based. So to get the right number, we have to add 1 per index to the sum of indices.
if @subset.sum == @combo.sum + @combo.elems {
If the sum of elements is the same as the sum of indices, we add the subset of elements
to @results.
@results.push(@subset);
}
}
This convoluted line is only to output @results in the same format as in the spec.
say @results
?? @results.map({ q{(} ~ @$_.join(q{, }) ~ q{)} }).join(q{, })
!! q{()};
As is often the case when translating Raku code to Perl, we have to provide our
own code to fill in gaps in functionality. In this case I had to provide replacement
for .combinations() and .sum(). Luckily, I had both just a cut and paste away.
my @results;
my @indices = keys @nums;
Unfortunately, my combinations() doesn't support a range of combination lengths so
I had to add an extra for loop instead.
for my $i (2 .. scalar @indices - 1) {
for my $combo (combinations(\@indices, $i)) {
my @subset = map { $nums[$_] } @{$combo};
if (sum(@subset) == sum(@{$combo}) + scalar @{$combo}) {
push @results, \@subset;
}
}
}
say @results
? join q{, }, map { q{(} . (join q{, }, @{$_}) . q{)} } @results
: q{()};