Perl Weekly Challenge: Week 292
Challenge 1:
Twice Largest
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.
The only fly in the ointment with this one is that we have to return the index of the largest number
not that number itself. But that is easy enough to get around with a hash (which I have imaginativly named %h.)
The keys of this hash are the elements of @ints and the values are their indices.
my %h;
for @ints.keys -> $i {
%h{@ints[$i]} = $i;
}
Now we sort @ints (via the keys of %h) in ascending numeric order...
my @sorted = %h.keys.sort({ $^a <=> $^b});
...and compare the largest value to the second largest. If the former is twice or more greater than the latter, we print its' index otherwise we print -1.
say @sorted[*-1] >= @sorted[*-2] * 2 ?? %h{@sorted[*-1]} !! -1
Update After I submitted this, it occured to me that the script could possibly give the wrong answer if @ints contained duplicate elements. The fix would be to swap the keys and values in %h. and create @sorted from %h.values instead of %h.keys. As
the results for the examples aren't affected I didn't make the change.
The Perl version is almost identical to Raku.
my %h;
for my $i (keys @ints) {
$h{$ints[$i]} = $i;
}
my @sorted = sort { $a <=> $b} keys %h;
say $sorted[-1] >= $sorted[-2] * 2 ? $h{$sorted[-1]} : '-1';
Challenge 2:
Zuma Game
You are given a single row of colored balls,
$rowand a random number of colored balls in$hand.Here is the variation of
Zumagame 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 ofthree or more consecutive ballsof thesame colorthen 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'm not sure if I've followed the best approach but I solved this by treating inserts as a tree and doing a depth-first search to find the optimum number.
The MAIN() function, which takes $row and $hand as parameters from the command-line arguments, looks like this:
First $hand is converted into a hash that has the different ball colors as keys and their quantity as values.
my %handCount;
for $hand.comb -> $ball {
%handCount{$ball}++ ;
}
Then, together with $row, the hash becomes a parameter to the search() function that will remember the minimum number
of inserts.
my $result = search($row, %handCount);
If that number was ∞, it means a solution is impossible so we print -1 otherwise we print the result.
say $result == ∞ ?? ∞ !! $result;
search() is where all the action happens.
sub search($row, %handCount) {
Because this function will be called recursively, we need to set up a halting condition so it does not run forever.
In this case, we can stop if $row is empty.
if $row eq q{} {
return 0;
}
The initial value for the minimum number of inserts is the highest possible value namely infinity.
my $minInserts = ∞;
Now we go through each position in $row...
for 0 .. $row.chars -> $i {
...and each color in $hand. (Via the keys of %handCount.)
for %handCount.keys -> $color {
If there are no more balls of that color we can skip to the next one.
if %handCount{$color} < 1 {
next;
}
We subtract one from the count for that color in %handCount.
%handCount{$color}--;
And create a new row with a ball of that color at the current position and clear() runs of three or more balls of the same
color as per the spec.
my $newRow =
clear($row.substr(0, $i) ~ $color ~ $row.substr($i));
Then we keep calling search() recursively until it halts. If this results in a lower value for
$minInserts, it becomees the new value.
$minInserts = ($minInserts, 1 + search($newRow, %handCount)).min;
The ball is put back into $hand and we continue on to the next position in $row.
%handCount{$color}++;
}
}
return $minInserts;
}
For competeness, this is the clear() function. All it does is use a regular expression repeatedly to remove
runs of three or more balls of the same color and return the edited row,
sub clear($row) {
my $newRow = $row;
while $newRow ~~ s:g/(.)$0$0+// {
}
return $newRow;
}
This is the Perl version. We have to proved our own min() function but everything else can be done with core Perl.
my $row = shift;
my @hand = split //, shift;
my %handCount;
for my $ball (@hand) {
$handCount{$ball}++ ;
}
my $result = search($row, %handCount);
say $result == 'Inf' ? '-1' : $result;
sub search($row, %handCount) {
if ($row eq q{}) {
return 0;
}
my $minInserts = 'Inf';
for my $i (0 .. length($row)) {
for my $color (keys %handCount) {
if ($handCount{$color} < 1) {
next;
}
$handCount{$color}--;
my $newRow =
clear(substr($row, 0, $i) . $color . substr($row, $i));
$minInserts = min($minInserts, 1 + search($newRow, %handCount));
$handCount{$color}++;
}
}
return $minInserts;
}
sub clear($row) {
while ($row =~ s/(.)\1\1+//g) {
}
return $row;
}