Perl Weekly Challenge: Week 282
Challenge 1:
Good Integer
You are given a positive integer,
$int, having3 or more digits.Write a script to return the
Good Integerin the given integer or-1if none found.A good integer is exactly three consecutive matching digits.
Example 1
Input: $int = 12344456
Output: "444"
Example 2
Input: $int = 1233334
Output: -1
Example 3
Input: $int = 10020003
Output: "000"
I thought this would be a simple regex but there were surprising complications.
In Perl, matching a digit followed by two instances of the same digit is easy with backreferences like this:
((\d)\2\2) # it is \2 because captures are numbered from outmost parentheses in
However this would give us a false positive for e.g. example 2 because 333 is followed by another 3. We need to match exactly three of the same digit. Normally we could get around this by making the next match a negated character class:
[^\2] # matches any character except the digit we previously matched.
But you can't do that! I don't know the the technical reason why you can't do this rather reasonable-sounding thing but the documentation states that only certain escapse sequences are valid inside a character class and backreferences are not included.
So I came up with this
\2+ # matches one or more instances of the digit we previously matched.
Making the whole regex
(((\d)\3\3)\3+) # the digit match is now \3 because of the additional parentheses
The idea is we can compare the whole match (in $1) with the match of three consecutive 3s (in $2).
If there were no additional 3s, the two would be equal. If there were, they would not be.
Unfortunately I wasn't quite done. In the case where there are exactly three of a digit, \3+ won't match at all
causing the whole regex to not match. Changing it to \3* (zero or more instances) fixed that.
This is the final product with input from the command-line, test and output.
shift =~ /(((\d)\3\3)\3*)/; say $1 == $2 ? $2 : "-1"
That took way longer than I thought it would but atleast I have a lot of experience with Perl regular expressions and was able to methodically work through it. Raku has changed things around a lot and I found myself in unfamiliar territory.
A straight translation from Perl like this:
( ( (\d) $0$0 ) $0* )
doesn't work because in Raku, capture group numbers are scoped to their surrounding parentheses so the $0 outside
((\d)$0$0) doesn't see the $0 inside it. Adding parentheses around $0* doesn't help either.
So I thought I would try assigning $0 to a variable and using that. This was the right track but I struggled with
the syntax. For instance this fails to do the right thing:
( ( (\d) $0$0 my $n=$0 ) ($n*) )
After much poring over documentation, I finally came up with this:
@*ARGS[0] ~~ /( ( (\d) $0$0 {} :my $n = $0;) ($n*) )/; say $0 == $0[0] ?? $0[0].Str !! "-1"
Apparently you need a code block (even an empty one like {}) to propogate the value of $0 outside. I still don't understand what the : before my() does.
Challenge 2:
Changing Keys
You are given an alphabetic string,
$str, as typed by user.Write a script to find the number of times user had to change the key to type the given string. Changing key is defined as using a key different from the last used key. The
shiftandcaps lockkeys won’t be counted.
Example 1
Input: $str = 'pPeERrLl'
Ouput: 3
p -> P : 0 key change
P -> e : 1 key change
e -> E : 0 key change
E -> R : 1 key change
R -> r : 0 key change
r -> L : 1 key change
L -> l : 0 key change
Example 2
Input: $str = 'rRr'
Ouput: 0
Example 3
Input: $str = 'GoO'
Ouput: 1
The solution to this one is not as concise as many of my recent solutions to weekly challenges, but algorithmically, it is quite simple.
The input string is split into individual characters with .comb(). The spec says case doesn't matter so first it
is converted to all lower-case with .lc().
my @chars = $str.lc.comb;
The first character is removed and assigned to a variable called $current.
my $current = @chars.shift;
A count is kept of how many changes have been observed.
my $changes = 0;
Then for each remaining character...
for @chars -> $c {
...if it is not the same as $current, $changes is incremented and it becomes the new value of $current.
if $c ne $current {
$changes++;
$current = $c;
}
}
Finally, the value of $changes is printed out.
say $changes;
This is the Perl version. It is a direct translation of the Raku code.
my @chars = split //, lc shift;
my $current = shift @chars;
my $changes = 0;
for my $c (@chars) {
if ($c ne $current) {
$changes++;
$current = $c;
}
}
say $changes;