Perl Weekly Challenge: Week 223
Challenge 1:
Count Primes
You are given a positive integer,
$n.Write a script to find the total count of primes less than or equal to the given integer.
Example 1
Input: $n = 10
Output: 4
Since there are 4 primes (2,3,5,7) less than or equal to 10.
Example 2
Input: $n = 1
Output: 0
Example 3
Input: $n = 20
Output: 8
Since there are 8 primes (2,3,5,7,11,13,17,19) less than or equal to 20.
Lately it's been a trend that the first problem in each weekly challenge can be solved in Raku as a one-liner. This week is no different. In fact we might even call it a zero-liner because I had a feeling we had seen this problem before. Sure enough it was task 2 from challenge 198. This is just a slightly tidied version of my code from there.
(1 .. @*ARGS[0]).grep({.is-prime}).elems.say
Basically all we are doing is .grep()ing through the numbers from 1 to $n for prime numbers using the .is-prime
method, counting the matches and printing the result.
For Perl, we have to provide our own code for determining prime numbers. I had an isPrime() function ready to
use from many previous challenges. With that, the Perl version is also a one-liner:
say scalar grep { isPrime($_) } 1 .. shift;
Challenge 2:
Box Coins
You are given an array representing box coins,
@box.Write a script to collect the maximum coins until you took out all boxes. If we pick
box[i]then we collect the coins$box[i-1] * $box[i] * $box[i+1]. If$box[i+1]or$box[i-1]is out of bound then treat it as1 coin.
Example 1
Input: @box = (3, 1, 5, 8)
Output: 167
Step 1: pick box [i=1] and collected coins 3 * 1 * 5 => 15. Boxes available (3, 5, 8).
Step 2: pick box [i=1] and collected coins 3 * 5 * 8 => 120. Boxes available (3, 8).
Step 3: pick box [i=0] and collected coins 1 * 3 * 8 => 24. Boxes available (8).
Step 4: pick box [i=0] and collected coins 1 * 8 * 1 => 8. No more box available.
Example 2
Input: @box = (1, 5)
Output: 10
Step 1: pick box [i=0] and collected coins 1 * 1 * 5 => 5. Boxes available (5).
Step 2: pick box [i=0] and collected coins 1 * 5 * 1 => 5. No more box available.
We can picture the various sequences of coin collection as branches in a tree and find the optimum answer by doing a breadth-first search of that tree.
First we need a queue to hold tree nodes we haven't searched yet. The queue will be modelled as an array.
my @q;
Each node will be an anonymous hash with two keys. The first, coins is the number of coins
collected so far. The second, box is the list of boxes that are still available.
The root of the tree is added to the queue. The box values is taken from the command-line arguments.
The coins value is 0.
@q.push({ coins => 0, box => @args });
We will also need a variable to store the maximum number of coins collected.
my $maxcoins = 0;
While the queue is not empty...
while @q.elems {
We take the first node off the queue. We could access it directly but having separate variable for the coins and boxes is more convenient and readable.
When I initially wrote this script, I was getting bizarre errors. Eventually I discovered
that when the list of boxes was getting .push()ed to the queue as part of a node, it was
somehow losing its' Listyness. Coercing it back into a List here solved the problem but
I don't understand why it happened.
my %node = @q.shift;
my $coins = %node<coins>;
my @box = %node<box>.List;
If there are no boxes left, we compare the number of coins collected with the maximum collected so far. If our value is bigger, it becomes the next maximum value and we move on to the next node in the queue.
if @box.elems == 0 {
if $coins > $maxcoins {
$maxcoins = $coins;
}
next;
}
If there are boxes then for each one...
for @box.keys -> $i {
By the way I just discovered you can use .keys() on a List to get the indexes instead of having
to write 0 .. @list.end. How cool! Any way for each one, we do the calculation mentioned in the spec
for collecting coins and add that to the number of coins already collected in this branch.
my $nextcoins = $coins + [*] (
$i == 0 ?? 1 !! @box[$i - 1],
@box[$i],
$i == @box.end ?? 1 !! @box[$i + 1]
);
We make a copy of the list of boxes and remove the current box from it.
my @nextbox = @box;
@nextbox.splice($i, 1);
Then we add the new values as a node in the tree and add it to the end of the queue.
@q.push({ coins => $nextcoins, box => @nextbox });
}
}
Once all branches of the tree have been processed, $maxcoins should contain the maximum possible
number of coins. We print this out.
say $maxcoins;
This is the Perl version. Porting it from Raku was uneventful.
my @q;
push @q, { coins => 0, box => \@ARGV };
my $maxcoins = 0;
while (scalar @q) {
my %node = %{ shift @q };
my $coins = $node{coins};
my @box = @{ $node{box} };
if (scalar @box == 0) {
if ($coins > $maxcoins) {
$maxcoins = $coins;
}
next;
}
for my $i (0 .. scalar @box - 1) {
my $nextcoins = $coins +
($i == 0 ? 1 : $box[$i - 1]) *
$box[$i] *
($i == scalar @box - 1 ? 1 : $box[$i + 1]);
my @nextbox = @box;
splice @nextbox, $i, 1;
push @q, { coins => $nextcoins, box => \@nextbox };
}
}
say $maxcoins;