Merge pull request #7457 from boblied/master

Week 201, and backlog week 186

3 files changed, 196 insertions, 2 deletions

diff --git a/challenge-201/bob-lied/README b/challenge-201/bob-lied/README
index 3d4521e11d..3c3241bd85 100644
--- a/challenge-201/bob-lied/README
+++ b/challenge-201/bob-lied/README
@@ -1,4 +1,4 @@
-Solutions to weekly challenge 200 by Bob Lied
+Solutions to weekly challenge 201 by Bob Lied
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-200/
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-201/
 https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-200/bob-lied
diff --git a/challenge-201/bob-lied/perl/ch-1.pl b/challenge-201/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..eacbd4b736
--- /dev/null
+++ b/challenge-201/bob-lied/perl/ch-1.pl
@@ -0,0 +1,70 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-1.pl Perl Weekly Challenge Week 201 Task 1 Missing Numbers
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given an array of unique numbers.
+# Write a script to find out all missing numbers in the range 0..$n
+# where $n is the array size.
+# Example 1 Input: @array = (0,1,3) Output: 2
+#   The array size i.e. total element count is 3, so the range is 0..3.
+#   The missing number is 2 in the given array.
+# Example 2 Input: @array = (0,1) Output: 2
+#   The array size is 2, therefore the range is 0..2.
+#   The missing number is 2.
+#=============================================================================
+
+use v5.36;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+# Take anything that looks list-ish as arguments, squash it together
+# and remove punctuation.  What's left should be a string of numbers.
+# Split that string on white space to get a list of numbers. This
+# is too rough -- it distorts negative numbers and decimal points, but
+# good enough for the examples and some quick tests.
+my $list = "@ARGV";
+$list =~ s/[[:punct:]]/ /g;
+
+say join(' ', missingNumber( [ split(' ', $list) ] )->@* );
+
+sub missingNumber($list)
+{
+    # Make a hash where the keys are numbers 0 .. n.  Start out assuming
+    # that every number is missing.  Note that $# works on references.
+    my $n = 1 + $#{$list};
+    my %missing = map { $_ => 1 } 0 .. $n;
+
+    # The ones in the list are not missing. Numbers that are out
+    # of range would be silently ignored in delete, but just to be
+    # explicit, let's only delete things that actually exist.
+    # This convenient syntax of 0<x<n is a feature of Perl 5.32.
+    delete $missing{$_} for grep { 0 <= $_ <= $n } $list->@*;
+
+    # Sort isn't actually required.
+    return [ sort { $a <=> $b } keys %missing ];
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( missingNumber( [ 0,1,3   ] ), [ 2 ], "Example 1");
+    is( missingNumber( [ 0,1     ] ), [ 2 ], "Example 2");
+
+    is( missingNumber( [ 2,3     ] ), [ 0,1   ], "Missing head");
+    is( missingNumber( [ 0,1,9   ] ), [ 2,3   ], "Missing tail");
+    is( missingNumber( [ 0,5,3,1 ] ), [ 2,4   ], "Missing multiple");
+    is( missingNumber( [ 8,9     ] ), [ 0,1,2 ], "Missing whole range");
+    is( missingNumber( [ 3,-1    ] ), [ 0,1,2 ], "Missing negative");
+
+    done_testing;
+}
+
diff --git a/challenge-201/bob-lied/perl/ch-2.pl b/challenge-201/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..d5db0c8ce8
--- /dev/null
+++ b/challenge-201/bob-lied/perl/ch-2.pl
@@ -0,0 +1,124 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-2.pl Perl Weekly Challenge Week 201 Task 2 Penny Piles
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given an integer, $n > 0.
+# Write a script to determine the number of ways of putting $n pennies
+# in a row of piles of ascending heights from left to right.
+# Example Input: $n = 5 Output: 7
+#   Since $n=5, there are 7 ways of stacking 5 pennies in ascending piles:
+#   1 1 1 1 1
+#   1 1 1 2
+#   1 2 2
+#   1 1 3
+#   2 3
+#   1 4
+#   5
+#=============================================================================
+# This amounts to finding the partitions of a number
+# https://en.wikipedia.org/wiki/Partition_(number_theory)
+# "No closed-form expression for the partition function is known, but it has
+# both asymptotic expansions that accurately approximate it and recurrence
+# relations by which it can be calculated exactly."
+#
+# We will do a recursive expansion and count the results. For each pair of
+# possible sums, recurse if the second term is large enough to have sums
+# where both terms are bigger than the smaller summand.
+# n=7                   n=8
+#   1 6                   1 7
+#   | 1 5                 | 1 6
+#   | | 1 4               | | 1 5
+#   | | | 1 3             | | | 1 4
+#   | | | | 1 2           | | | | 1 3
+#   | | | |   1 1         | | | |   1 2
+#   | | | 2 2             | | | |     1 1
+#   | | 2 3               | | | | 2 2
+#   | 2 4                 | | | 2 3
+#   | | 2 2               | | 2 4
+#   | 3 3                 | | | 2 2
+#   2 5                   | | 3 3
+#   | 2 3                 | 2 5
+#   3 4                   | | 2 3
+#                         | 3 4
+#   Total = 15            2 6       Total = 22
+#                           2 4
+#                             2 2
+#                           3 3
+#                         3 5
+#                         4 4
+#=============================================================================
+
+use v5.36;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+say pennyPiles($_) for @ARGV;
+
+sub pennyPiles($n)
+{
+    # We're accumulating all the possible orderings. We don't
+    # really have to do that to get the answer, but it helps debugging.
+    my @result = ( [ $n ] );
+    say "PUSH [ $n ]" if $Verbose;
+    _pile(1, $n-1, [], \@result, "");
+
+    say showResult(\@result) if $Verbose;
+    return scalar(@result);
+}
+
+sub _pile($p, $q, $soFar, $result, $indent)
+{
+    say "${indent}[$soFar->@*] _pile($p, $q)," if $Verbose;
+
+    # Take pairs of summands, but only in one order
+    while (  $p <= $q )
+    {
+        say "${indent}PUSH [ $soFar->@* $p $q ]" if $Verbose;
+        push @$result, [ $soFar->@*, $p, $q ];
+
+        # If the second term can be split into additions where both
+        # terms are greater than p, then recurse to that.
+        # For example, (2 6) can split the 6 into 2+4 or 3+3, but not
+        # 1+5 because the 1 would violate the ordering rule.
+        # For (3 4) we can't split the 4 in a way where both terms
+        # are at least 3.
+        if ( $q >= 2*$p )
+        {
+            _pile($p, $q-$p, [ $soFar->@*, $p ], $result, "  $indent");
+        }
+        $p++; $q--;
+    }
+}
+
+sub showResult($result)
+{
+    for my $array ($result->@*) # ( sort { $#{$a} <=> $#{$b} } $result->@* )
+    {
+        say "[ $array->@* ]";
+    }
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    #is( pennyPiles(1),  1, "Test 1");
+    #is( pennyPiles(2),  2, "Test 2");
+    #is( pennyPiles(3),  3, "Test 3");
+    #is( pennyPiles(4),  5, "Test 4");
+    #is( pennyPiles(5),  7, "Example 1");
+    is( pennyPiles(6), 11, "Test 6");
+    is( pennyPiles(7), 15, "Test 7");
+    is( pennyPiles(8), 22, "Test 8");
+
+    done_testing;
+}
+