Perl Weekly Challenge 312.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 312.
Task 1: Minimum Time
Submitted by: Mohammad Sajid Anwar
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
I split the input strings into characters and map a-z to the numbers
0-25. The number of steps $s to reach a letter $y starting from
letter $x going clockwise is then $s=$y-$x if $y>=$x. If $y<$x I
can give a full turn taking 26 steps and then subtract the distance
|$y-$x|=$x-$y, so I would have to walk $s=26+$x-$y steps. Both
results can be summarized as $s=($y-$x)%26 using modular
arithmetic. Similarly, to reach $y from $x going anticlockwise I
just change the sign, $s=($x-$y)%26. I can compute both numbers and
choose the smallest one. There is an additional operation for printing
each letter, so I have to add to the total number of steps the length
of the string. This yields a 1.5-liner
Examples:
perl -MList::Util=min -E '
for(@ARGV){$s=length;$c=0;($d,$c)=($c-$_,$_),$s+=min($d%26,-$d%26)
for map{(ord)-97}split "";say "$_ -> $s"}
' abc bza zjpc
Results:
abc -> 5
bza -> 7
zjpc -> 34
The full code is:
1 # Perl weekly challenge 312
2 # Task 1: Minimum Time
3 #
4 # See https://wlmb.github.io/2025/03/09/PWC312/#task-1-minimum-time
5 use v5.36;
6 use List::Util qw(min);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 S1 S2...
9 to find the time required to print the strings S1 S2...
10 using a daisy typerwriter
11 FIN
12 my $ord_a = ord("a");
13 my $Nletters=1 + ord("z") - $ord_a;
14 for(@ARGV){
15 my $time=length;
16 my $current=0;
17 my $difference;
18 ($difference, $current) =($current-$_, $_),
19 $time += min($difference % $Nletters, -$difference % $Nletters)
20 for map {(ord)-$ord_a } split "";
21 say "$_ -> $time"}
Example:
./ch-1.pl abc bza zjpc
Results:
abc -> 5
bza -> 7
zjpc -> 34
Task 2: Balls and Boxes
Submitted by: Mohammad Sajid Anwar
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
I build an array of boxes containing a hash that maps colors to number of balls. Then I map each box to a boolean value, true (1) if all colors have been initialized, and I sum those values over all boxes. The result fits a 1.5-liner.
Examples:
perl -MList::Util=all,sum0 -E '
for(@ARGV){my @b;for my($c,$b)(split ""){++$b[$b]{$c}}say "$_ -> ",sum0
map{all{$_}@{$b[$_]}{R,G,B}}(0..@b-1);}
' G0B1R2R0B0 G1R3R6B3G6B1B6R1G3 B3B2G1B3
Results:
G0B1R2R0B0 -> 1
G1R3R6B3G6B1B6R1G3 -> 3
B3B2G1B3 -> 0
The full code is
1 # Perl weekly challenge 312
2 # Task 2: Balls and Boxes
3 #
4 # See https://wlmb.github.io/2025/03/09/PWC312/#task-2-balls-and-boxes
5 use v5.40;
6 use List::Util qw(sum0 all);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 S1 S2...
9 to count boxes with balls of all colors, where each strings Sn is of the form
10 P1P2... with each pair Pj of the form Cb with C a color (R, G or B) and b a
11 box number (0..9), meaning there is a ball of color C in box b.
12 FIN
13 for(@ARGV){
14 try {
15 die "Wrong format: $_" unless /^([RGB]\d)*$/;
16 my @boxes;
17 for my($color, $box) (split ""){
18 ++$boxes[$box]{$color};
19 }
20 say "$_ -> ",sum0 map{all{$_}@{$boxes[$_]}{qw(R G B)}}(0..@boxes-1);
21 } catch($e) {
22 say $e;
23 }
24 }
Example:
./ch-2.pl G0B1R2R0B0 G1R3R6B3G6B1B6R1G3 B3B2G1B3
Results:
G0B1R2R0B0 -> 1
G1R3R6B3G6B1B6R1G3 -> 3
B3B2G1B3 -> 0
/;