Perl Weekly Challenge 292.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 292.
Task 1: Twice Largest
Submitted by: Mohammad Sajid Anwar
You are given an array of integers, @ints, where the largest integer is unique.
Write a script to find whether the largest element in the array is at least twice
as big as every element in the given array. If it is return the index of the
largest element or return -1 otherwise.
Example 1
Input: @ints = (2, 4, 1, 0)
Output: 1
The largest integer is 4.
For every other elements in the given array is at least twice as big.
The index value of 4 is 1.
Example 2
Input: @ints = (1, 2, 3, 4)
Output: -1
The largest integer is 4.
4 is less than twice the value of 3, so we return -1.
I can reverse sort the array and check that the first element is larger than twice the second. As I need the index besides the value, I first apply a Schwarzian-like transform. This fits a 1.5-liner.
Example 1:
perl -E '
@i=@ARGV; @o=sort{$b->[1] <=> $a->[1]} map{[$_, $i[$_]]}0..@i-1;
$r=$o[0][1]>=2*$o[1][1]?$o[0][0]:-1; say "@i -> $r"
' 2 4 1 0
Results:
2 4 1 0 -> 1
Example 2:
perl -E '
@i=@ARGV; @o=sort{$b->[1] <=> $a->[1]} map{[$_, $i[$_]]}0..@i-1;
$r=$o[0][1]>=2*$o[1][1]?$o[0][0]:-1; say "@i -> $r"
' 1 2 3 4
Results:
1 2 3 4 -> -1
The full code adds a few checks.
1 # Perl weekly challenge 292
2 # Task 1: Twice Largest
3 #
4 # See https://wlmb.github.io/2024/10/21/PWC292/#task-1-twice-largest
5 use v5.36;
6 die <<~"FIN" unless @ARGV;
7 Usage: $0 N0 N1...
8 to find the index of the largest element of the array N0 N1...
9 if it is not smaller than twice the second largest.
10 FIN
11 my @sorted = sort {$b->[1] <=> $a->[1]} map {[$_, $ARGV[$_]]} 0..@ARGV-1;
12 my $result = @sorted <= 1? -1
13 : $sorted[0][1] >= 2*$sorted[1][1]? $sorted[0][0]
14 : -1;
15 say "@ARGV -> $result";
Examples:
./ch-1.pl 2 4 1 0
./ch-1.pl 1 2 3 4
Results:
2 4 1 0 -> 1
1 2 3 4 -> -1
Notice that I don’t compare absolute values, so the behavior for negative numbers may seem surprising.
./ch-1.pl -2 -4 -1 0
Results:
-2 -4 -1 0 -> 3
This is correct as the element 3, i.e., 0 is larger than 2*(-1).
Task 2: Zuma Game
Submitted by: Mohammad Sajid Anwar
You are given a single row of colored balls, $row and a random number
of colored balls in $hand.
Here is the variation of Zuma game as your goal is to clear all of the
balls from the board. Pick any ball from your hand and insert it in between
two balls in the row or on either end of the row. If there is a group of
three or more consecutive balls of the same color then remove the group
of balls from the board. If there are no more balls on the board then you
win the game. Repeat this process until you either win or do not have any
more balls in your hand.
Write a script to minimum number of balls you have to insert to clear all
the balls from the board. If you cannot clear all the balls from the board
using the balls in your hand, return -1.
Example 1
Input: $board = "WRRBBW", $hand = "RB"
Output: -1
It is impossible to clear all the balls. The best you can do is:
- Insert 'R' so the board becomes WRRRBBW. WRRRBBW -> WBBW.
- Insert 'B' so the board becomes WBBBW. WBBBW -> WW.
There are still balls remaining on the board, and you are out of balls to insert.
Example 2
Input: $board = "WWRRBBWW", $hand = "WRBRW"
Output: 2
To make the board empty:
- Insert 'R' so the board becomes WWRRRBBWW. WWRRRBBWW -> WWBBWW.
- Insert 'B' so the board becomes WWBBBWW. WWBBBWW -> WWWW -> empty.
2 balls from your hand were needed to clear the board.
Example 3
Input: $board = "G", $hand = "GGGGG"
Output: 2
To make the board empty:
- Insert 'G' so the board becomes GG.
- Insert 'G' so the board becomes GGG. GGG -> empty.
2 balls from your hand were needed to clear the board.
I guess one could use some heuristics, but, being short of time, I
made a program that explores exhaustively all possible solutions and
chooses the best. It extracts one ball from the hand, from all possible
possitions, and adds it to the board at all possible positions. I
represent both hand and board with strings, one letter to a color, so
that I can use substr to remove and add balls and regular
expressions to remove repeated groups. After doing a step
with one ball, I use recursion on the remaining hand and board. The
result may be packed into a 3-liner, but it is not too clear. The
full version seems more comprehensible.
Example 1:
perl -E '
($d, $h)=@i=@ARGV;say "@i -> ",p($d,$h);sub p($d,$h){my$l=length $h;my$r=-1;return 0 if $d eq "";return
-1 if $l == 0;for(0..$l-1){my$n=$h;my$c=substr$n,$_,1,"";for(0..length$d){my $e=$d;substr $e, $_,0,$c;
1 while $e=~s/(.)\1\1\1*//;my $t=p($e, $n);$r=$t+1 if $t!=-1 && ($r==-1 || $t<$r);}}$r;}
' WRRBBW RB
Results:
WRRBBW RB -> -1
Example 2:
perl -E '
($d, $h)=@i=@ARGV;say "@i -> ",p($d,$h);sub p($d,$h){my$l=length $h;my$r=-1;return 0 if $d eq "";return
-1 if $l == 0;for(0..$l-1){my$n=$h;my$c=substr$n,$_,1,"";for(0..length$d){my $e=$d;substr $e, $_,0,$c;
1 while $e=~s/(.)\1\1\1*//;my $t=p($e, $n);$r=$t+1 if $t!=-1 && ($r==-1 || $t<$r);}}$r;}
' WWRRBBW WRBRW
Results:
WWRRBBW WRBRW -> 2
Even though the example is small, it took several seconds to find the optimal solution. That’s the problem with exhaustive searches. I can actually bring the time down significatively by memoizing.
perl -MMemoize -E '
memoize "p"; ($d, $h)=@i=@ARGV;say "@i -> ",p($d,$h);sub p($d,$h){my$l=length $h;my$r=-1;return 0 if $d eq "";return
-1 if $l == 0;for(0..$l-1){my$n=$h;my$c=substr$n,$_,1,"";for(0..length$d){my $e=$d;substr $e, $_,0,$c;
1 while $e=~s/(.)\1\1\1*//;my $t=p($e, $n);$r=$t+1 if $t!=-1 && ($r==-1 || $t<$r);}}$r;}
' WWRRBBW WRBRW
Results:
WWRRBBW WRBRW -> 2
From 7 to 0.1s.
Example 3:
perl -MMemoize -E '
memoize "p"; ($d, $h)=@i=@ARGV;say "@i -> ",p($d,$h);sub p($d,$h){my$l=length $h;my$r=-1;return 0 if $d eq "";return
-1 if $l == 0;for(0..$l-1){my$n=$h;my$c=substr$n,$_,1,"";for(0..length$d){my $e=$d;substr $e, $_,0,$c;
1 while $e=~s/(.)\1\1\1*//;my $t=p($e, $n);$r=$t+1 if $t!=-1 && ($r==-1 || $t<$r);}}$r;}
' G GGGGG
Results:
G GGGGG -> 2
The full code follows:
1 # Perl weekly challenge 292
2 # Task 2: Zuma Game
3 #
4 # See https://wlmb.github.io/2024/10/21/PWC292/#task-2-zuma-game
5 use v5.36;
6 use Memoize;
7 die <<~"FIN" unless @ARGV==2;
8 $0 board hand
9 to play the Zuma Game. The board and hand are string where each
10 letter represents a color. Outputs the minimum number of steps
11 to clear the board or -1 if it is not possible
12 FIN
13 my ($board, $hand) = @ARGV;
14 memoize "play";
15 say "@ARGV -> ", play($board, $hand);
16
17 sub play($board, $hand){
18 my $length = length $hand;
19 my $result = -1;
20 return 0 if $board eq ""; # Nothing to do if the board is already clear
21 return -1 if $length == 0; # Failure if no more balls
22 for(0 .. $length-1){ # choose a ball
23 my $newhand = $hand;
24 my $ball=substr $newhand, $_, 1, ""; # remove it from the hand
25 for(0 .. length $board){ # choose a position in the board
26 my $newboard = $board;
27 substr $newboard, $_, 0, $ball; # add the ball to the board
28 1 while $newboard =~ s/(.)\1\1\1*//; # remove groups of 3+ balls
29 my $next = play($newboard, $newhand); # recurse
30 $result = $next + 1 if $next != -1 &&
31 ($result == -1 || $next < $result); # update current result
32 }
33 }
34 return $result;
35 }
36
Examples:
./ch-2.pl WRRBBW RB
./ch-2.pl WWRRBBW WRBRW
./ch-2.pl G GGGGG
Results:
WRRBBW RB -> -1
WWRRBBW WRBRW -> 2
G GGGGG -> 2
/;
Written on October 21, 2024