Perl Weekly Challenge: Week 348

Challenge 1:

String Alike

You are given a string of even length.

Write a script to find out whether the given string can be split into two halves of equal lengths, each with the same non-zero number of vowels.

Example 1
Input: $str = "textbook"
Output: false

1st half: "text" (1 vowel)
2nd half: "book" (2 vowels)
Example 2
Input: $str = "book"
Output: true

1st half: "bo" (1 vowel)
2nd half: "ok" (1 vowel)
Example 3
Input: $str = "AbCdEfGh"
Output: true

1st half: "AbCd" (1 vowel)
2nd half: "EfGh" (1 vowel)
Example 4
Input: $str = "rhythmmyth"
Output: false

1st half: "rhyth" (0 vowel)
2nd half: "mmyth" (0 vowel)
Example 5
Input: $str = "UmpireeAudio"
Output: false

1st half: "Umpire" (3 vowels)
2nd half: "eAudio" (5 vowels)

We start by finding the index of the midpoint of Str by taking the length (with .chars()) and dividing that by 2.

my $mid = $str.chars / 2;

We use this and .substr() to split $str into the characters before the midpoint and those at and after it. As we are guaranteed by the spec that Str is an even number of characters long, this will gives us two substrings of equal length we'll call $first and $second.

my $first = $str.substr(0, $mid);
my $second = $str.substr($mid);

To avoid repetition, we'll assign the regular expression to match any vowel, lower or upper case, to a variable. Note the character class that contains the vowels is wrapped in parentheses; this makes it a capture group.

my $vowels = / (<[a e i o u A E I O U]>) /;

.match() returns a list of capture groups found so we can count vowels in $first and $second by .match()ing and counting how many capture groups were found with .elems().

my $firstVowels = $first.match($vowels, :g).elems;
my $secondVowels = $second.match($vowels, :g).elems;

Now we just need to check if the count of vowels in each substring is equal and print the result with say(). Well, not quite, we also need to check if there is atleast 1 vowel in each substring otherwise we will get the wrong answer for e.g. example 4.

say $firstVowels > 0 && $secondVowels > 0 && $firstVowels == $secondVowels;

(Full code on Github.)

The Perl version is mostly a straightforward copy of the Raku version but I did run into one problem.

my $mid = (length $str) / 2;
my $first = substr $str, 0, $mid;
my $second = substr $str, $mid;
my $vowels = qr/([aeiouAEIOU])/;

In scalar context, the match operator returns true or false (i.e. 1 or undef.) It is only in list context we get the list of groups captured. As $firstVowels and $secondVowels are scalars, we will need to force array context. Now, if we had to force scalar context, it would be easy, there is a scalar keyword just for that purpose. But if you look at the documentation for scalar you will see it says:

There is no equivalent operator to force an expression to be interpolated in list context because in practice, this is never needed.

Uh, yes it is needed. Right here for instance. So what to do? Simply adding parentheses around the match operator like this:

my $firstVowels = ( $first =~ /$vowels/g );

doesn't work. Some alternatives that do work include assigning to an intermediate array:

my $firstVowels = @_ = $first =~ /$vowels/g;

or using the substitution operator which does the right thing:

my $firstVowels = $first =~ s/$vowels//g;

But they are ugly, make the code less clear and the second method is destructive and could cause problems if we wanted to use $firstVowels later on.

The documentation for scalar goes on to say:

If you really wanted to do so, however, you could use the construction @{[ (some expression) ]}

And that's what I did.

my $firstVowels = @{[ $first =~ /$vowels/g ]};
my $secondVowels = @{[ $second =~ /$vowels/g ]};

How this works is [] create a list reference and @{} then dereferences it again resulting in an array. It has the marginal advantage of being somewhat documented (albeit not in a place a newbie would think to look.) and it is understandable for an experienced Perl programmer but it would have been so much clearer and simple if there was a list keyword.

Recently, there has been much discussion in the Perl community over an article entitled What killed Perl? I can't help but think these weird quirks and omissions in the language are part of the problem.

Here also: we have to put 0+ or equivalent before the expression to supress a warning about say being interpreted as a function and boolean values do not have default printable values. This atleast is simple stuff you can learn easily if you use Perl for a while but why should you even have to?

say 0+($firstVowels > 0 && $secondVowels > 0 && $firstVowels == $secondVowels)
    ? 'true'
    : 'false';

(Full code on Github.)

Challenge 2:

Convert Time

You are given two strings, $source and $target, containing time in 24-hour time form.

Write a script to convert the source into target by performing one of the following operations:

1. Add  1 minute
2. Add  5 minutes
3. Add 15 minutes
4. Add 60 minutes

Find the total operations needed to get to the target.

Example 1
Input: $source = "02:30"
    $target = "02:45"
Output: 1

Just one operation i.e. "Add 15 minutes".
Example 2
Input: $source = "11:55"
    $target = "12:15"
Output: 2

Two operations i.e. "Add 15 minutes" followed by "Add 5 minutes".
Example 3
Input: $source = "09:00"
    $target = "13:00"
Output: 4

Four operations of "Add 60 minutes".
Example 4
Input: $source = "23:45"
    $target = "00:30"
Output: 3

Three operations of "Add 15 minutes".
Example 5
Input: $source = "14:20"
    $target = "15:25"
Output: 2

Two operations, one "Add 60 minutes" and one "Add 5 minutes"

After collection $source and $target from the command-line parameters, we start our solution by splitting each one into hour and minute components using .split().

my ($sourceHours, $sourceMinutes) = $source.split(':');
my ($targetHours, $targetMinutes) = $target.split(':');

Using these, we find the $difference between the target and source times in minutes.

my $diff = ($targetHours * 60 + $targetMinutes) -
    ($sourceHours * 60 + $sourceMinutes);

We make a List of the operations mentioned in the spec, arranging them from largest to smallest.

my @ops = 60, 15, 5, 1;

We also need a variable to keep track of how many operations we have performed.

my $count = 0;

To solve the challenge, we are going to backwards from the target time to the source time. In other words we need to count the least number of operations it takes to reduce the $diff to 0.

So for each operation in @ops...

for @ops -> $op {

... we are going to subtract it (not add, we're going backwards remember) from $diff and keep subtracting it (and incrementing $count each time) as long as $diff is greater or equal to the value of the operation.

     while $diff >= $op {
        $diff -= $op;
        $count++;
    }

When it is not, we will move on to the next operation.

}

As the amount of the last operation is 1, this loop will stop when $diff is 0. At this point, we output the value of $count and we are done.

say $count;

The procedure described above mostly works but fails for example 4. The target time is on the next day and we haven't accounted for that. One of the many joys of working with dates and times! To deal with this, I added the following code just after the split of $source and $target into hours and minutes.

if $targetHours < $sourceHours {
    $targetHours += 24;
}

(Full code on Github.)

What this does is if the target times' hours are less than the source times' hours, it is assumed that the target refers to a time on the next day. That would be a risky assumption to make in real life, you would need the date along with the time in that case, but for the purpose of this challenge it is ok. So one day, i.e. 24 hours is added to $targetHours.

This is the Perl version. It works the same as Raku.

my ($sourceHours, $sourceMinutes) = split /:/, $source;
my ($targetHours, $targetMinutes) = split /:/, $target;

if ($targetHours < $sourceHours) {
    $targetHours += 24;
}

my $diff = ($targetHours * 60 + $targetMinutes) -
    ($sourceHours * 60 + $sourceMinutes);
my @ops = (60, 15, 5, 1);
my $count = 0;

for my $op (@ops) {
        while ($diff >= $op) {
        $diff -= $op;
        $count++;
    }
}

say $count;

(Full code on Github.)