Perl Weekly Challenge 285.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 285.

Task 1: No Connection

Submitted by: Mohammad Sajid Anwar
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"

We are looking for nodes on the right hand side of any route that are not on the left side of any different route. Thus, we can make two hashes, one of right and one of left sides and grep those that have no outgoing connection. I will assume that the list of routes is really a list of legs, i.e., a single directed edge with only two nodes, incoming and outgoing. The input is given in @ARGV as a simple even-sized list. I iterate over the list a pair at a time using for_list. The result fits a one-liner.

Example 1:

perl -Mexperimental=for_list -E '
for my($i,$o)(@ARGV){++$i{$i} if $i ne $o; ++$o{$o}}say "@ARGV -> ", join " ", grep{!$i{$_}}keys %o
' B C D B C A

Results:

B C D B C A -> A

Example 2:

perl -Mexperimental=for_list -E '
for my($i,$o)(@ARGV){++$i{$i} if $i ne $o; ++$o{$o}}say "@ARGV -> ", join " ", grep{!$i{$_}}keys %o
' A Z

Results:

A Z -> Z

Other examples:

perl -Mexperimental=for_list -E '
for my($i,$o)(@ARGV){++$i{$i} if $i ne $o; ++$o{$o}}say "@ARGV -> ", join " ", grep{!$i{$_}}keys %o
' A A B B B A
perl -Mexperimental=for_list -E '
for my($i,$o)(@ARGV){++$i{$i} if $i ne $o; ++$o{$o}}say "@ARGV -> ", join " ", grep{!$i{$_}}keys %o
' A C B C A B B A
perl -Mexperimental=for_list -E '
for my($i,$o)(@ARGV){++$i{$i} if $i ne $o; ++$o{$o}}say "@ARGV -> ", join " ", grep{!$i{$_}}keys %o
' A B B C C A
perl -Mexperimental=for_list -E '
for my($i,$o)(@ARGV){++$i{$i} if $i ne $o; ++$o{$o}}say "@ARGV -> ", join " ", grep{!$i{$_}}keys %o
' A B A C

Results:

A A B B B A -> A
A C B C A B B A -> C
A B B C C A ->
A B A C -> C B

Notice that I assumed that an edge connecting a node to itself is not to be considered an output connection.

The corresponding full code is:

 1  # Perl weekly challenge 285
 2  # Task 1:  No Connection
 3  #
 4  # See https://wlmb.github.io/2024/09/02/PWC285/#task-1-no-connection
 5  use v5.36;
 6  use experimental qw(for_list);
 7  die <<~"FIN" unless @ARGV and @ARGV%2==0;
 8      Usage: $0 I1 O1 I2 O2...
 9      where Ii is the incoming and Oi the outgoing node
10      of the i-th edge.
11      FIN
12  my (%in, %out);
13  for my($in,$out)(@ARGV){
14      ++$in{$in} if $in ne $out;
15      ++$out{$out};
16  }
17  say "@ARGV -> ", join " ", grep{!$in{$_}}keys %out;

Examples:

./ch-1.pl B C D B C A
./ch-1.pl A Z
./ch-1.pl A A B B B A
./ch-1.pl A C B C A B B A
./ch-1.pl A B B C C A
./ch-1.pl A B A C

Results:

B C D B C A -> A
A Z -> Z
A A B B B A -> A
A C B C A B B A -> C
A B B C C A ->
A B A C -> C B

Task 2: Making Change

Submitted by: David Ferrone
Compute the number of ways to make change for given amount in cents.
By using the coins e.g. Penny, Nickel, Dime, Quarter and Half-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

A simple solution is a recursive procedure: the number n of ways of making the amount a starting with a coin of value c and using coins of value not larger than c is n(a,c)=sum(n(a-c,c')) over c'<=c. To avoid unnecesary repetead calculations, I memoize the subroutine. To simplify the logic, I start the recursion adding an non-existing coin whose value is larger than all others, and adding the same value to the initial amount. The result fits a two-liner

perl -MMemoize -E '
memoize "n";@d=(1,5,10,25,50);$l=51;for(@ARGV){say "$_ -> ",n($_+$l,$l)}sub n($a,$c){
return 0 if $c>$a;return 1 if $c==$a;my $t;$t+=n($a-$c,$_)for grep{$_<=$c}@d;$t}
' 9 15 100 1000 10000

Results:

9 -> 2
15 -> 6
100 -> 292
1000 -> 801451
10000 -> 6794128501

This took 0.1s in my old laptop. Without memoizing it took 7 seconds for an amount of just 600.

The corresponding full code is:

 1  # Perl weekly challenge 285
 2  # Task 2:  Making Change
 3  #
 4  # See https://wlmb.github.io/2024/09/02/PWC285/#task-2-making-change
 5  use v5.36;
 6  use Memoize;
 7  die <<~"FIN" unless @ARGV;
 8      Usage: $0 A1 A2...
 9      to find in how many ways can the amounts Ai can be
10      formed with coins (pennies, nickels, dimes, quartes
11      and half-dollars)
12      FIN
13  memoize qw(number_of_ways);
14  my @values=(1,5,10,25,50); # sorted
15  my $large=1+$values[-1]; # larger than largest coin
16  for(@ARGV){
17      say "$_ -> ",number_of_ways($_+$large, $large)
18  }
19  sub number_of_ways($amount,$first_coin){
20      return 0 if $first_coin>$amount;
21      return 1 if $first_coin==$amount;
22      my $total;
23      $total+=number_of_ways($amount-$first_coin, $_)for grep{$_<=$first_coin}@values;
24      return $total;
25  }

Examples:

./ch-2.pl 9 15 100 1000 10000

Results:

9 -> 2
15 -> 6
100 -> 292
1000 -> 801451
10000 -> 6794128501

/;

Written on September 2, 2024