Perl Weekly Challenge: Week 329
Challenge 1:
Counter Integers
You are given a string containing only lower case English letters and digits.
Write a script to replace every non-digit character with a space and then return all the distinct integers left.
Example 1
Input: $str = "the1weekly2challenge2"
Output: 1, 2
2 is appeared twice, so we count it one only.
Example 2
Input: $str = "go21od1lu5c7k"
Output: 21, 1, 5, 7
Example 3
Input: $str = "4p3e2r1l"
Output: 4, 3, 2, 1
In Raku, this is a one-liner. First we substitute non-digits in the first command-line parameter.
Because @*ARGS is immutable, we have to use the S version of the substitution parameter. Then we remove
whitespace at the beginning and end of the string with .trim(). I initially omitted this step but that resulted in an unsightly extra space in the output. Now we have a string with numbers and varying amounts of whitespace
bewtween them; .split() extracts just the numbers. .unique() removes any duplicate numbers. .join() makes
the output look a little nicer and .say() prints it out.
(S:g/\D/ / given @*ARGS[0]).trim.split(/\s+/).unique.join(q{, }).say
Alas, we cannot do a one-liner in Perl because we need to provide a replacement for unique(). I had
one from previous challenges but it did not preserve the order of elements as the output in the spec does.
So I wrote a different function I call orderedUnique.
It takes a list as its only parameter.
sub orderedUnique(@list) {
A list holds the result.
my @ordered;
A Hash is used to keep track of elements seen so we can find duplicates.
my %seen;
For each element in the input...
for my $elem (@list) {
...if the element has not been seen before it is added to the seen elements and the element is added to the list of ordered results.
unless (exists $seen{$elem}) {
$seen{$elem} = true;
push @ordered, $elem;
}
If the element has been seen, it is a duplicate. It is ignored and we move on to the next element.
}
Finally, the ordered unique elements are returned.
return @ordered;
}
On to the main code, $str is taken from the first command-line argument.
my $str = shift;
The non-digit characters in it are replaced with spaces.
$str =~ s/\D/ /g;
Whitespace is trimmed from the beginning and of the string.
$str =~ s/^\s+ || \s+$//g;
The numbers are extracted with split(), duplicates are removed with orderedUnique() and the result
is output with join() and say().
say join q{, }, orderedUnique(split /\s+/, $str);
Challenge 2:
Nice String
You are given a string made up of lower and upper case English letters only.
Write a script to return the longest substring of the give string which is nice. A string is nice if, for every letter of the alphabet that the string contains, it appears both in uppercase and lowercase.
Raku
Example 1
Input: $str = "YaaAho"
Output: "aaA"
Example 2
Input: $str = "cC"
Output: "cC"
Example 3
Input: $str = "A"
Output: ""
No nice string found.
This one was more complicated than I thought it would be at first glance.
First we Generate all possible substrings of $str and stores them in @substrings.
my @substrings;
for 0 .. $str.chars - 1 -> $i {
for $i .. $str.chars -> $j {
@substrings.push($str.substr($i, $j));
}
}
Now we Iterate over each .unique() substring. A little optimization I did here was to .sort() the substrings
from longest to shortest. This way we will find the longest nice string a little faster.
for @substrings.unique.sort({ $^b.chars <=> $^a.chars }) -> $substring {
For each substring, we split it into individual characters with .comb() and classify each character into lowercase and uppercase groups. This is done with the .classify() method which creates a Hash called
%case and adds each character to keys called lower and upper respectively.
$substring.comb.classify({$_ eq $_.lc ?? 'lower' !! 'upper'}, :into(my %case));
The .values() of the two keys are de-duplicated with .unique(), .sort()ed and .join()ed back into
strings which are then compared (The upper string is converted to lowercase so the two strings can be compared
case-insensitively.)
if %case<lower>.values.unique.sort.join eq %case<upper>.values.unique.sort.join.lc {
If they match, it is a nice string. The longest one because of the sorting we did earlier. The substring is printed out and we caese processing.
say $substring;
last;
}
}
This is the Perl version.
We can avoid Perls' lack of unique() by storing the substrings in a hash rather than a list.
my %substrings;
for my $i (0 .. length($str) - 1) {
for my $j ($i .. length($str)) {
$substrings{substr($str, $i, $j)} = true;
}
}
Thus keys %substrings will give the unique substrings.
for my $substring (sort { length $b <=> length $a } keys %substrings) {
We don't have classify() either so we just loop through the characters and manually assign each one
to hashes called %lower and %upper. Once again, by use of hashes, we can avoid the need for a unique()
function. Also we can store upper-case characters directly as lower case avoiding the need for calling lc()
later.
my %lower;
my %upper;
for my $c (split //, $substring) {
if ($c eq lc $c) {
$lower{$c}++;
} else {
$upper{lc $c}++;
}
}
if ((join q{}, sort keys %lower) eq (join q{}, sort keys %upper)) {
say $substring;
last;
}
}