Perl Weekly Challenge: Week 236
Challenge 1:
Exact Change
You are asked to sell juice each costs $5. You are given an array of bills. You can only sell ONE juice to each customer but make sure you return exact change back. You only have $5, $10 and $20 notes. You do not have any change in hand at first.
Write a script to find out if it is possible to sell to each customers with correct change.
Example 1
Input: @bills = (5, 5, 5, 10, 20)
Output: true
From the first 3 customers, we collect three $5 bills in order.
From the fourth customer, we collect a $10 bill and give back a $5.
From the fifth customer, we give a $10 bill and a $5 bill.
Since all customers got correct change, we output true.
Example 2
Input: @bills = (5, 5, 10, 10, 20)
Output: false
From the first two customers in order, we collect two $5 bills.
For the next two customers in order, we collect a $10 bill and give back a $5 bill.
For the last customer, we can not give the change of $15 back because we only have two $10 bills.
Since not every customer received the correct change, the answer is false.
Example 3
Input: @bills = (5, 5, 5, 20)
Output: true
This is the kind of problem that can be quite complicated in real life but if you read the spec carefully, there are only a couple of possible conditions to check so it isn't that hard to solve really.
First we need to keep track of how many of each value bill we have. Actually we don't need to worry about $20 bills in this problem but we might as well count them for completeness's sake.
my $fives = 0;
my $tens = 0;
my $twenties = 0;
Then we go through each bill received from a customer. (These values are input from the command-line arguments.)
for @bills -> $bill {
given $bill {
If we are given a $5 bill, we take it, give the customer their juice and that's the end of the transaction; everyone is happy.
when 5 {
$fives++;
}
If we are given a $10 bill, we need to have atleast one $5 bill we can give as change. If we have it, we give it to the customer (subtracting it from our count), add 1 to the count of $10 bills we have and again the transaction is finished.
when 10 {
if $fives > 0 {
$fives--;
$tens++;
If we don't have a $5 bill, we call a function called nochange().
} else {
nochange();
}
}
nochange() is very simple:
sub nochange {
say 'false';
exit(0);
}
It just prints the word 'false' and exits the script.
If we are given a $20 bill, it is slightly more complicated.
when 20 {
Along with his juice, we need to give the customer $15 in change. There are two ways we can do that. As a $10 bill and a $5 bill...
if $tens > 0 && $fives > 0 {
$tens -= 1;
$fives -= 1;
$twenties += 1;
...or as three $5 bills.
} elsif $fives > 2 {
$fives -= 3;
$twenties += 1;
In both cases, our stocks are checked to make sure we have enough of the required bills to give change and if so the appropriate quantities are added or subtracted as necessary.
If we couldne't make change in either of those two ways, nochange() is called again.
} else {
nochange();
}
}
To guard against invalid input, if the amount of $bill was not 5, 10 or 20, the script die()s with an error message.
default {
die "illegal bill value\n";
}
}
}
If we have managed to successfully give change for all the bills, we print 'true'.
say "true";
The Perl version only required very minor syntactic changes. The only small stumbling block is that given/when is
still after all these years considered experimental so you have to use experimental qw/ switch /; at the top of the script
to prevent an unsightly warning message.
sub nochange {
say 'false';
exit(0);
}
my $fives = 0;
my $tens = 0;
my $twenties = 0;
for my $bill (@ARGV) {
given ($bill) {
when (5) {
$fives++;
}
when (10) {
if ($fives > 0) {
$fives--;
$tens++;
} else {
nochange();
}
}
when (20) {
if ($tens > 0 && $fives > 0) {
$tens -= 1;
$fives -= 1;
$twenties += 1;
} elsif ($fives > 2) {
$fives -= 3;
$twenties += 1;
} else {
nochange();
}
}
default {
die "illegal bill value\n";
}
}
}
say "true";
Challenge 2:
Array Loops
You are given an array of unique integers.
Write a script to determine how many loops are in the given array.
To determine a loop: Start at an index and take the number at array[index] and then proceed to that index and continue this until you end up at the starting index.
Example 1
Input: @ints = (4,6,3,8,15,0,13,18,7,16,14,19,17,5,11,1,12,2,9,10)
Output: 3
To determine the 1st loop, start at index 0, the number at that index is 4, proceed to index 4, the number at that index is 15, proceed to index 15 and so on until you're back at index 0.
Loops are as below:
[4 15 1 6 13 5 0]
[3 8 7 18 9 16 12 17 2]
[14 11 19 10]
Example 2
Input: @ints = (0,1,13,7,6,8,10,11,2,14,16,4,12,9,17,5,3,18,15,19)
Output: 6
Loops are as below:
[0]
[1]
[13 9 14 17 18 15 5 8 2]
[7 11 4 6 10 16 3]
[12]
[19]
Example 3
Input: @ints = (9,8,3,11,5,7,13,19,12,4,14,10,18,2,16,1,0,15,6,17)
Output: 1
Loop is as below:
[9 4 5 7 19 17 15 1 8 12 18 6 13 2 3 11 10 14 16 0]
This is another problem which looked like it may be difficult but turns out to be quite simple when you think about it.
As well the list of @ints we are to check, as we look for loops, we will also need a data structure to keep track of which
ones we have seen. For this purpose I chose a hash. When an element of @ints is examined, its index is added as a key
in %seen. If that key already exists, it means the element has already been seen and therefore the loop is complete.
I only maintain one such hash because I am assuming none of the loops overlap which is the case for all the examples.
my %seen;
This variable contains a count of how many loops have been found. It starts from 1 because there will always be at least 1 loop.
my $loops = 1;
We also need to keep track of which elements' index we are currently looking at.
my $current = 0;
Until the number of seen elements is equal to the number of elements in the @ints list (i.e. we have
examined every element in @ints)
while %seen.keys.elems != @ints.elems {
If the index of the current element already exists in %seen we have reached the end of a loop.
if %seen{$current}:exists {
The number of found loops is incremented.
$loops++;
@ints is scanned from the beginning to find the next unseen index. That becomes the new current index and the search
is called off. If there were no unseen indexes, nothing happens.
for 0 .. @ints.end -> $i {
if %seen{$i}:!exists {
$current = $i;
last;
}
}
}
The current index is added to %seen.
%seen{$current} = True;
The value of the element at the current index becomes the new current index.
$current = @ints[$current];
}
By the time we reach here, all the element indexes have been visited and we can print the number of loops we found.
say $loops;
This is the Perl version. Once again very little had to be done to convert it from Raku.
my @ints = @ARGV;
my %seen;
my $loops = 1;
my $current = 0;
while (scalar keys %seen != scalar @ints) {
if (exists $seen{$current}) {
$loops++;
for my $i (0 .. scalar @ints - 1) {
if (!exists $seen{$i}) {
$current = $i;
last;
}
}
}
$seen{$current} = 1;
$current = $ints[$current];
}
say $loops;