Perl Weekly Challenge 236: Exact Change
These are some answers to the Week 236, Task 1 of the Perl Weekly Challenge organized by Mohammad S. Anwar.
Spoiler Alert: This weekly challenge deadline is due in a few days from now (on October 1, 2023 at 23:59). This blog post offers some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.
Task 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 customer 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
Exact Change in Raku
The sell-juice
subroutine keeps track of the available change available. It loops on the bills provided by customers and check each time whether the necessary change is available. It also adds the banknote provided by the customer in the %change
hash. It returns False
when the change is not available. If we get through to the end of the input array, then we return True
. Note that for an input of 20, we need to give back 15. We first try to give a 10 and a 5 banknote and, if not possible (no available 10 banknote), then we try to give back three 5 banknotes.
sub sell-juice (@in) {
# %change stores the stock of bank notes. No need to
# count $20 notes but it makes the code more generic
my %change = '5' => 0, '10' => 0, '20' => 0;
for @in -> $i {
%change{$i}++;
given $i {
when 5 {next}
when 10 {
return False if %change{5} < 1;
%change{5}--;
next;
}
when 20 {
if %change{10} > 0 and %change{5} > 0 {
%change{10}--; %change{5}--;
next;
} elsif %change{5} >= 3 {
%change{5} -= 3; next;
} else {
return False;
}
}
}
}
return True;
}
my @tests = <5 5 5 10 20>, <5 5 10 10 20>, <5 5 5 20>;
for @tests -> @test {
printf "%-15s => ", "@test[]";
say sell-juice @test;
}
This program displays the following output:
$ raku ./exact-change.raku
5 5 5 10 20 => True
5 5 10 10 20 => False
5 5 5 20 => True
Exact Change in Perl
This is a port to Perl of the above Raku program. The only significant change is that the given ... when
construct is replaced with nested if ... then ... else
conditionals. Asides from that, please refer to the above section if you need further explanations.
use strict;
use warnings;
use feature 'say';
sub sell_juice {
# %change stores the stock of bank notes. No need to
# count $20 notes but it makes the code more generic
my %change = ('5' => 0, '10' => 0, '20' => 0);
for my $i (@_){
$change{$i}++;
next if $i == 5;
if ($i == 10) {
return "false" if $change{5} < 1;
$change{5}--;
next;
} elsif ($i == 20) {
if ($change{10} > 0 and $change{5} > 0) {
$change{10}--; $change{5}--;
next;
} elsif ($change{5} >= 3) {
$change{5} -= 3; next;
} else {
return "false";
}
}
}
return "true";
}
my @tests = ([<5 5 5 10 20>], [<5 5 10 10 20>], [<5 5 5 20>]);
for my $test (@tests) {
printf "%-15s => ", "@$test";
say sell_juice @$test;
}
This program displays the following output:
$ perl exact-change.pl
5 5 5 10 20 => true
5 5 10 10 20 => false
5 5 5 20 => true
Wrapping up
The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on October 8, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.
Leave a comment