Perl Weekly Challenge: Week 285
Challenge 1:
No Connection
You are given a list of routes,
@routes.Write a script to find the destination with no further outgoing connection.
Example 1
Input: @routes = (["B","C"], ["D","B"], ["C","A"])
Output: "A"
"D" -> "B" -> "C" -> "A".
"B" -> "C" -> "A".
"C" -> "A".
"A".
Example 2
Input: @routes = (["A","Z"])
Output: "Z"
At first I thought I wouldn't be able to provide a one-line solution for this problem but Raku rose to the occasion.
my @a = @*ARGS.words.pairup; (@a.map({$_.value}) ∖ @a.map({$_.key})).keys.join.say
I was thinking I would have to make an elaborate graph data structure and follow routes from node to node but then I had the insight that the routes are one-way only so a destination would have no further outgoing connections if it appears as the second member of a pair but never as the first.
To this end I took the input (a number of command-line arguments, each one containing a pair of destinations separated by spaces) and turned them into a List of Pairs using .words() and .pairup(). This was then turned into two Lists, the first by using .map() and .value() to extract the second member of each pair and the second by using .map() and .key() to get the first member of each pair. These were used as operands to the set difference operator ∖ which gives the set all the elements in its first operand that are not in the second operand. Because the result is a Set it has to be run through .keys() to get the elements and as their potentially could be more than one result (not in the examples though) they are .join()ed before being output with .say().
For the Perl version we have to create a set difference function.
sub setDifference($arr1, $arr2) {
It works by mapping the elements of the first array to the keys of a hash. The initial value associated with each key is 0.
my %difference = map { $_ => 0 } @{$arr1};
Then for every element in the second array, if it exists as a key in the hash, the value of that key is incremented.
for my $elem (@{$arr2}) {
if (exists $difference{$elem}) {
$difference{$elem}++;
}
}
After we have finished, any keys in the hash which have 0 value will indicate elements
which are in array 1 but not in array 2. These are found with keys() and grep(), sort()ed and returned.
return sort grep { !$difference{$_} } keys %difference;
}
In the main body of the script first we create two arrays to hold the first and second members of each route pair.
my @first;
my @second;
We extract these pairs from the command-line arguments as we did for Raku and add each member to the appropriate array.
for my $arg (@ARGV) {
@_ = split /\s+/, $arg;
push @first, $_[0];
push @second, $_[1];
}
Now we can use our setDifference() function to find the answer or answers and print it.
say join q{ }, setDifference(\@second, \@first);
Challenge 2:
Making Change
Compute the number of ways to make change for given amount in cents. By using the coins e.g.
Penny,Nickel,Dime,QuarterandHalf-dollar, in how many distinct ways can the total value equal to the given amount? Order of coin selection does not matter.
A penny (P) is equal to 1 cent.
A nickel (N) is equal to 5 cents.
A dime (D) is equal to 10 cents.
A quarter (Q) is equal to 25 cents.
A half-dollar (HD) is equal to 50 cents.
Example 1
Input: $amount = 9
Ouput: 2
1: 9P
2: N + 4P
Example 2
Input: $amount = 15
Ouput: 6
1: D + 5P
2: D + N
3: 3N
4: 2N + 5P
5: N + 10P
6: 15P
Example 3
Input: $amount = 100
Ouput: 292
This is the kind of problem I remember being discussed in the Discrete Mathematics course I took in University. That was a long, long time ago and I've forgotten pretty much everything I was taught. Lucky for me, my daughter graduated with a degree in Computer Science earlier this year and her memory is still fresh about such things so I'm going to credit Shailaja as the co-author of this solution.
To make things a little more legible, I assigned constants for each coin value.
constant PENNY = 1;
constant NICKEL = 5;
constant DIME = 10;
constant QUARTER = 25;
constant HALFDOLLAR = 50;
And an array to hold them all ordered by value from highest to lowest.
constant @coins = (HALFDOLLAR, QUARTER, DIME, NICKEL, PENNY);
The MAIN() function is very simple:
say changeCombinations($amount + HALFDOLLAR, HALFDOLLAR);
It just calls a function changeCombinations() with the amount input and the first coin in the array.
HALFDOLLAR is added to the amount so our function will process all the coins. The result of this function will
be printed.
This is changeCombinations().
sub changeCombinations($amount, $largestCoin){
It is designed to be called recursively so we need ensure there are halting conditions so it does not keep running until the script crashes.
There are two. The first is if the largest coin under consideration is greater than the amount. In this case we return 0.
if $largestCoin > $amount {
return 0;
}
The second is if the largest coin is equal to the amount. In this case we return 1.
if $largestCoin == $amount {
return 1;
}
If neither of these conditions are met we can proceed.
We need a variable to store the total number of combinations found so far.
my $total;
Then for each of the coins which are smaller or equal to the largest coin, we call this function again
this time subtracting the value of the largest coin from the amount and making the current coin the largest coin. The result of each call will be added to $total.
for @coins.grep({ $_ <= $largestCoin }) -> $coin {
$total += changeCombinations($amount - $largestCoin, $coin);
}
Eventually, we will hit a halting condition and then we can return $total.
return $total;
}
I'm a little hazy on the exact technical reasons why but Perl doesn't completely support recursion. A script like ours will cause a earning about "deep recursion." The warning is spurious in this case so we can surpress it by putting this line at the top of the script:
no warnings qw/ recursion /;
Constants can be defined in Perl using a pragma like this:
use constant PENNY => 1;
use constant NICKEL => 5;
use constant DIME => 10;
use constant QUARTER => 25;
use constant HALFDOLLAR => 50;
sub changeCombinations($amount, $largestCoin){
Because the list of coins will not be changed in this function I declared it as a state variable.
Or I could have made it a constant outside of the function as in Raku.
state @coins=(PENNY, NICKEL, DIME, QUARTER, HALFDOLLAR);
The rest of the script works the same as in Raku.
if ($largestCoin > $amount) {
return 0;
}
if ($largestCoin == $amount) {
return 1;
}
my $total;
for my $coin (grep {$_ <= $largestCoin} @coins) {
$total += changeCombinations($amount - $largestCoin, $coin);
}
return $total;
}
my ($amount) = @ARGV;
my $largestCoin = HALFDOLLAR;
say changeCombinations($amount + $largestCoin, $largestCoin)