Perl Weekly Challenge: Week 312

Challenge 1:

Minimum Time

You are given a typewriter with lowercase english letters a to z arranged in a circle.

Typing a character takes 1 sec. You can move pointer one character clockwise or anti-clockwise.

The pointer initially points at a.

Write a script to return minimum time it takes to print the given string.

Example 1

Input: $str = "abc"
Output: 5

The pointer is at 'a' initially.
1 sec - type the letter 'a'
1 sec - move pointer clockwise to 'b'
1 sec - type the letter 'b'
1 sec - move pointer clockwise to 'c'
1 sec - type the letter 'c'

Example 2

Input: $str = "bza"
Output: 7

The pointer is at 'a' initially.
1 sec - move pointer clockwise to 'b'
1 sec - type the letter 'b'
1 sec - move pointer anti-clockwise to 'a'
1 sec - move pointer anti-clockwise to 'z'
1 sec - type the letter 'z'
1 sec - move pointer clockwise to 'a'
1 sec - type the letter 'a'

Example 3

Input: $str = "zjpc"
Output: 34

We start by initializing two variables to store the elapsed time and the letter currently being pointed to.

my $time = 0;
my $current = 'a';

The input is split into individual characters with .comb() and for each character...

for $str.comb -> $char {

...we compare it to the character currently being pointed to by using .ord() to get the numeric value of each of the two and subtracting to get the difference. Because we don't care about the sign, we run the result through .abs().

    my $distance = ($char.ord - $current.ord).abs;

The distance we have just calculated is the amount we would have to move if we went clockwise, however we also havw the option to move the pointer counter-clockwise which could potentially be nearer (thus faster.) We can get that distance by subtracting the already calculated distance from 26. Whichever value is smaller (determined with .min()) is added to the time plus 1 extra second for the time to actually type the letter.

    $time += ($distance, 26 - $distance).min + 1;

The character becomes the new current character and the loop begins again.

    $current = $char;
}

After the entire string has been processed, we output the total time with say().

say $time;

(Full code on Github.)

The Perl version works the same way but we have to provide our own min() function.

my $time = 0;
my $current = 'a';

for my $char (split //, $str) {
    my $distance = abs(ord($char) - ord($current));
    $time += min($distance, 26 - $distance) + 1;
    $current = $char;
}

say $time;

(Full code on Github.)

Challenge 2:

Balls and Boxes

There are $n balls of mixed colors: red, blue or green. They are all distributed in 10 boxes labelled 0-9.

You are given a string describing the location of balls.

Write a script to find the number of boxes containing all three colors. Return 0 if none found.

Example 1

Input: $str = "G0B1R2R0B0"
Output: 1

The given string describes there are 5 balls as below:
Box 0: Green(G0), Red(R0), Blue(B0) => 3 balls
Box 1: Blue(B1) => 1 ball
Box 2: Red(R2) => 1 ball

Example 2

Input: $str = "G1R3R6B3G6B1B6R1G3"
Output: 3

The given string describes there are 9 balls as below:
Box 1: Red(R1), Blue(B1), Green(G1) => 3 balls
Box 3: Red(R3), Blue(B3), Green(G3) => 3 balls
Box 6: Red(R6), Blue(B6), Green(G6) => 3 balls

Example 3

Input: $str = "B3B2G1B3"
Output: 0

Box 1: Green(G1) => 1 ball
Box 2: Blue(B2)  => 1 ball
Box 3: Blue(B3)  => 2 balls

We can keep track of the balls in an array of hashes. The top level array will represent the boxes and each element will be a hash whoses keys are colors. (the value doesn't matter, only if the key exists or not.)

my @boxes;

Using a regular expression, we parse the input string to get the color of each ball and which box it goes in and use that information to populate the @boxes array.

for $str.match(/(<[RGB]>) (\d)/, :g) -> ($color, $box) {
    @boxes[$box]{$color} = True;
}

Now we .grep() through @boxes and find out how many elements have 3 keys (i.e. atleast one ball of each color.) We count these using .elems() and print the result with .say().

@boxes.grep({ %$_.keys.elems == 3 }).elems.say;

(Full code on Github.)

This is the Perl version.

my @boxes;

while ($str =~ /(([RGB]) (\d))/gmx) {
    my ($color, $box) = ($2, $3);

Here we are using the new builtin true value. It is not (as of version 5.38) fully integrated into Perl so we have to put use builtin qw/ true /; no warnings qw/ experimental::builtin /; at the top of the script.

    $boxes[$box]{$color} = true;
}

say scalar grep { scalar keys %{$_} == 3 } @boxes;

(Full code on Github.)