Perl Weekly Challenge: Week 374
Challenge 1:
Count Vowel
You are given a string.
Write a script to return all possible vowel substrings in the given string. A vowel substring is a substring that only consists of vowels and has all five vowels present in it.
Example 1
Input: $str = "aeiou"
Output: ("aeiou")
Example 2
Input: $str = "aaeeeiioouu"
Output: ("aaeeeiioou", "aaeeeiioouu", "aeeeiioou", "aeeeiioouu")
Example 3
Input: $str = "aeiouuaxaeiou"
Output: ("aeiou", "aeiou", "eiouua", "aeiouu", "aeiouua")
Example 4
Input: $str = "uaeiou"
Output: ("aeiou", "uaeio", "uaeiou")
Example 5
Input: $str = "aeioaeioa"
Output: ()
I thought this weeks challenges would be a piece would be a piece of cake to solve with regular expressions but they turned out to have unexpected difficulties.
I started with Perl as I'm still more comfortable with Perl regular expressions.The first step wad creating an array to hold any vowel substrings found.
my @results;
Then we search for sequences of vowels. A regular expression works for this purpose.
for my $match ($str =~ /([aeiou]+)/g) {
For each match found, we record its' length.
my $len = length $match;
Now we have to find each substring within the match. Because a valid substring will at the minimum contain one of each vowel, a small optimization we can do is to only search only substrings which are at least 5 characters long.
for my $start (0 .. $len - 5) {
for my $end ($start + 5 .. $len) {
my $substring = substr $match, $start, $end - $start;
Again we use a regular expression. This time we use the regular expression
engines lookahead feature to ensure that the substring contains at least one
a, e, i, o and u. If it does, we add it to @results.
if ($substring =~ /(?=.*a)(?=.*e)(?=.*i)(?=.*o)(?=.*u)/) {
push @results, $substring;
}
}
}
}
Finally we output @results in the same style as in the examples.
say q{(}, (join q{, }, map { "\"$_\"" } @results), q{)};
I still have a suspicion that the whole thing could have been done as one big regular expression but for now this will do.
This is the Raku version. The Raku regular expression syntax is more verbose but we can follow the same method as Perl.
my @results;
for $str.match(/(<[aeiou]>+)/, :g) -> $match {
my $len = $match.chars;
for 0 .. $len - 5 -> $start {
for $start + 5 .. $len -> $end {
my $substring = $match.substr($start, $end - $start);
if $substring.match(/
(<?before .*a>)
(<?before .*e>)
(<?before .*i>)
(<?before .*o>)
(<?before .*u>)
/) {
@results.push($substring);
}
}
}
}
say q{(}, @results.map({ "\"$_\"" }).join(q{, }), q{)};
Challenge 2:
Largest Same-digits Number
You are given a string containing 0-9 digits only.
Write a script to return the largest number with all digits the same in the given string.
Example 1
Input: $str = "6777133339"
Output: 3333
Example 2
Input: $str = "1200034"
Output: 4
Example 3
Input: $str = "44221155"
Output: 55
Example 4
Input: $str = "88888"
Output: 88888
Example 5
Input: $str = "11122233"
Output: 222
The second challenge was a lot easier and once again, regular expressions
played a central part. In this Raku one-liner, first I got the input from the
first command-line argument and then I .match()ed it against all instances
of a digit followed by 0 or more (i.e. *) of the same digit. Why not one or
more (i.e. +)? Consider example 4; the largest as in longest sequence is 000 but the largest as in highest value is 4. The latter definition is what
the spec seems to mean by largest. So we must consider sequences of length 1
too. Having got all the matches, we first convert them from Regex objects
to Strings with the hyperoperator ».Str. Then we .sort() them in
descending numeric order, select the .first() (i.e. largest) one and print
it out with .say().
@*ARGS[0].match(/((\d) $0*)/, :g)».Str.sort({$^b <=> $^a}).first.say
In Perl, I had a problem with getting the right backreference (Raku is more intuitive here in my opinion.) and you can't easily force list context so I had to awkwardly convert the sorted list of matches to a list reference and back to get the first element. Despite this, the Perl one-liner is considerably shorter.
say [ sort {$b <=> $a} $ARGV[0] =~ /((\d)\2*)/g ]->[0]