Challenge 285 Task 1 and 2 solutions in Perl by Matthias Muth

3 files changed, 164 insertions, 39 deletions

diff --git a/challenge-285/matthias-muth/README.md b/challenge-285/matthias-muth/README.md
index b0761730f3..9c5771b04a 100644
--- a/challenge-285/matthias-muth/README.md
+++ b/challenge-285/matthias-muth/README.md
@@ -73,17 +73,19 @@ sub no_connection( $routes ) {
 > Input: \$amount = 100<br/>
 > Ouput: 292<br/>
 
-I use a **recursive approach** for this task.
+#### Recursive Approach
 
-To get good sequences, without any permutations, all sequences are generated using higher coin values first, with only the same or lower values following. This means that whenever we add a given value to a sequence, we need to make sure that no higher values will be added to it anymore.
+I decided to use a **recursive approach** for this task.
+
+To get good sequences, without permutations (sort of 'coins flipping', pun intended), all sequences start with higher coin values, and each coin is followed only by coins of the same or lower value. This means that whenever we add a given value to a sequence, we need to make sure that *no higher values* will be added to it anymore.
 
 How do we do that?
 
-For the parameters of my recursive function, we don't only use the amount to change, but also a list of currently available coins values. This list can (and will!) vary as we descend down into the recursion, as higher values will be excluded.
+For the parameters of my recursive function, there is the amount to change, for sure, but I also add a list of currently available coins values. This list can (and will!) vary as we descend down into the recursion, as higher values will be excluded.
 
-A call to the function walks through those coin values, for each of them trying to add it to the sequence:
+A call to the function walks through the given coin values, adding up the number of possible sequences starting with each coin:
 
-* If this coin value is too high, no combination is possible, so nothing is counted.
+* If this coin value is higher than the amount, no combination is possible, so nothing is counted.
 * If the coin value matches the amount exactly, we have found a combination, which we count (as 1).
 * If the coin value is lower than the amount, we use that coin and descend into a recursion,
 to find the number of possible combinations for the rest of the amount.<br/>
@@ -92,11 +94,11 @@ are only the current coin value and all following lower ones.<br/>
 The number of combinations returned by the recursive call
 is added to the total number of combinations in the current call.
 
-For convenience we allow the function to be called with *only* an amount, and *no* list of coin values.
-This is for the main call. In that case, we supply the list of coin values from the task description (50, 25, 10, 5, 1) as a default value.
+For convenience, we also allow the function to be called with *only* an amount, and *no* list of coin values.
+This is for the main call. In that case, we set the list of coin values to the full (50, 25, 10, 5, 1) from the task description as a default. From then on, in the recursive calls, we always will have a non-empty set of coins as parameters.  
 
-We will get around 7.500 recursive calls for Example 3.<br/>
-Perl emits a warning when it detects a certain number of recursive calls (which is not really high). I think it's safe in our case to suppress this warning.   
+We get around 7.500 recursive calls for Example 3.<br/>
+Perl emits a warning when it detects a certain number of recursive calls (100, which is not really high).<br/>It's safe in our case to suppress this warning.   
 
 ```perl
 use v5.36;
@@ -120,7 +122,9 @@ say making_change( 15 );
 say making_change( 100 );
 ```
 
-'In reality', I use this for actually running the examples:
+#### Real testing
+
+`Test::V0` is a core module now, no need to install it from CPAN anymore!<br/>I love it!<br/>So 'in reality', I run the examples as tests:
 
 ```perl
 use Test2::V0 qw( -no_srand );
@@ -142,6 +146,102 @@ ok 3 - Example 3: making_change( 100 ) == 292
 1..3
 ```
 
- 
+#### Using `Memoize` to reduce recursive call counts
+
+Computing the number of sequences for smaller coin values over and over again, as it happens with the recursive function, is a waste of resources. Around 7500 calls for changing the amount of 100 is still ok, but the number of calls will grow exponentially with larger amount.
+
+Two simple lines can solve that problem:
+
+```perl
+use Memoize;
+memoize( 'making_change' );
+```
+
+This reduces the number of calls drastically.
+
+I have instrumented my recursive function with a call count, that I can print out after the main call of the function has run. The call count is reset for each main call (one without coin parameters, remember):
+
+```perl
+my $call_count = 0;
+
+sub making_change( $amount, @coins ) {
+
+    $call_count = 0
+        unless @coins;
+    ++$call_count;
+
+    @coins = qw( 50 25 10 5 1 )
+        unless @coins;
+
+    my $n = 0;
+    for ( 0..$#coins ) {
+        $n +=
+            $coins[$_] > $amount    ? 0
+            : $coins[$_] == $amount ? 1
+            : making_change( $amount - $coins[$_], @coins[$_..$#coins] );
+    }
+    return $n;
+}
+
+```
+
+Then I have put the tests into a loop of two rounds, one without and one with 'memoizing':
+
+```perl
+use Test2::V0 qw( -no_srand );
+use Memoize;
+
+for my $round ( 1..2 ) {
+
+    if ( $round == 1 ) {
+        note "without Memoize:";
+    }
+    elsif ( $round == 2 ) {
+        note "using Memoize:";
+        memoize( 'making_change' );
+    }
+
+    is making_change( 9 ), 2,
+        'Example 1: making_change( 9 ) == 2';
+    note "call_count $call_count";
+    is making_change( 15 ), 6,
+        'Example 2: making_change( 15 ) == 6';
+    note "call_count $call_count";
+    is making_change( 100 ), 292,
+        'Example 3: making_change( 100 ) == 292';
+    note "call_count $call_count";
+
+    note "";
+}
+done_testing;
+```
+
+The call count is reduced *drastically*:
+
+```shell
+# without Memoize:
+ok 1 - Example 1: making_change( 9 ) == 2
+# call_count 13
+ok 2 - Example 2: making_change( 15 ) == 6
+# call_count 35
+ok 3 - Example 3: making_change( 100 ) == 292
+# call_count 7455
+# 
+# using Memoize:
+ok 4 - Example 1: making_change( 9 ) == 2
+# call_count 10
+ok 5 - Example 2: making_change( 15 ) == 6
+# call_count 10
+ok 6 - Example 3: making_change( 100 ) == 292
+# call_count 122
+# 
+1..6
+```
+
+From `7455` down to `122`!
+
+Performance tuning can be so easy!
+
+
 
 ## **Thank you for the challenge!**
diff --git a/challenge-285/matthias-muth/perl/ch-1.pl b/challenge-285/matthias-muth/perl/ch-1.pl
index 1e31b14e52..ef36f1c3a4 100755
--- a/challenge-285/matthias-muth/perl/ch-1.pl
+++ b/challenge-285/matthias-muth/perl/ch-1.pl
@@ -10,20 +10,13 @@
 
 use v5.36;
 
-sub no_connection( $routes ) {
-    # Store all given routes in a hash ( from => to ).
-    my %from_to = map { $_->[0] => $_->[1] } $routes->@*;
-    # Return the first 'to' node that does not have a route going out of it.
-    return ( grep { ! exists $from_to{$_} } values %from_to )[0];
-}
-
-use List::Util qw( unpairs );
+use List::Util qw( unpairs first );
 
 sub no_connection( $routes ) {
     # Store all given routes in a hash ( from => to ).
     my %connections = unpairs $routes->@*;
     # Return the first destination node that does not have a route going out of it.
-    return ( grep { ! exists $connections{$_} } values %connections )[0];
+    return first { ! exists $connections{$_} } values %connections;
 }
 
 use Test2::V0 qw( -no_srand );
diff --git a/challenge-285/matthias-muth/perl/ch-2.pl b/challenge-285/matthias-muth/perl/ch-2.pl
index 0442850a61..fb1f259fb9 100755
--- a/challenge-285/matthias-muth/perl/ch-2.pl
+++ b/challenge-285/matthias-muth/perl/ch-2.pl
@@ -11,52 +11,68 @@
 use v5.36;
 no warnings 'recursion';
 
-sub making_change( $amount, @coins ) {
+my $call_count = 0;
+
+# Full version, including debugging output and call counting.
+my $verbose = 1;
+sub vsay( @args ) { say @args if $verbose }
+sub making_change_full( $amount, @coins ) {
     state $indent = "";
+
+    $call_count = 0
+        unless @coins;
+    ++$call_count;
+
     @coins = qw( 50 25 10 5 1 )
         unless @coins;
-    say $indent, "making_change( $amount, @coins )";
+    vsay $indent, "making_change( $amount, @coins )";
     $indent .= "  ";
     my $n = 0;
     for ( 0..$#coins ) {
         if ( $coins[$_] > $amount ) {
-            say $indent, "$coins[$_] is too big";
-            next;
+            vsay $indent, "$coins[$_] is too big";
         }
         elsif ( $coins[$_] == $amount ) {
             ++$n;
-            say $indent, "$coins[$_] is the exact amount. Found a combination.";
-            next;
+            vsay $indent, "$coins[$_] is the exact amount. Found a combination.";
         }
         else {
             # $coins[$_] < $amount
-            say $indent, "adding coin of $coins[$_] to the sequence,",
+            vsay $indent, "adding coin of $coins[$_] to the sequence,",
                 " trying to change the rest of ", $amount - $coins[$_];
             $n += making_change( $amount - $coins[$_], @coins[$_..$#coins] );
         }
     }
 
-    say $indent, "returning n==$n";
+    vsay $indent, "making_change( $amount, @coins ) returning $n";
     substr $indent, -2, 2, "";
     return $n;
 }
 
+# 'Real' version (with call counting added).
 sub making_change( $amount, @coins ) {
+
+    $call_count = 0
+        unless @coins;
+    ++$call_count;
+
     @coins = qw( 50 25 10 5 1 )
         unless @coins;
+
     my $n = 0;
     for ( 0..$#coins ) {
         $n +=
-            $coins[$_] > $amount  ? 0
+            $coins[$_] > $amount    ? 0
             : $coins[$_] == $amount ? 1
             : making_change( $amount - $coins[$_], @coins[$_..$#coins] );
     }
     return $n;
 }
 
+# 'Compressed' version (shortest).
+# Nice to avoid the loop, but maybe less readable.
 use List::Util qw( sum );
-
-sub making_change_3( $amount, @coins ) {
+sub making_change_short( $amount, @coins ) {
     @coins = qw( 50 25 10 5 1 )
         unless @coins;
     return sum(
@@ -68,13 +84,29 @@ sub making_change_3( $amount, @coins ) {
     );
 }
 
-say making_change( 9 );
-
 use Test2::V0 qw( -no_srand );
-is making_change( 9 ), 2,
-    'Example 1: making_change( 9 ) == 2';
-is making_change( 15 ), 6,
-    'Example 2: making_change( 15 ) == 6';
-is making_change( 100 ), 292,
-    'Example 3: making_change( 100 ) == 292';
+use Memoize;
+
+for my $round ( 1..2 ) {
+
+    if ( $round == 1 ) {
+        note "without Memoize:";
+    }
+    elsif ( $round == 2 ) {
+        note "using Memoize:";
+        memoize( 'making_change' );
+    }
+
+    is making_change( 9 ), 2,
+        'Example 1: making_change( 9 ) == 2';
+    note "call_count $call_count";
+    is making_change( 15 ), 6,
+        'Example 2: making_change( 15 ) == 6';
+    note "call_count $call_count";
+    is making_change( 100 ), 292,
+        'Example 3: making_change( 100 ) == 292';
+    note "call_count $call_count";
+
+    note "";
+}
 done_testing;