Merge pull request #7482 from PerlMonk-Athanasius/branch-for-challenge-201

Perl & Raku solutions to Tasks 1 & 2 for Week 201

4 files changed, 756 insertions, 0 deletions

diff --git a/challenge-201/athanasius/perl/ch-1.pl b/challenge-201/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..82f6ae2269
--- /dev/null
+++ b/challenge-201/athanasius/perl/ch-1.pl
@@ -0,0 +1,177 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 201
+=========================
+
+TASK #1
+-------
+*Missing Numbers*
+
+Submitted by: Mohammad S Anwar
+
+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.
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Interface
+---------
+If no command-line arguments are given, the test suite is run.
+
+Assumption
+----------
+Numbers in the input array are integers.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $USAGE =>
+"Usage:
+  perl $0 [<array> ...]
+  perl $0
+
+    [<array> ...]    A list of 1 or more unique integers\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 201, Task #1: Missing Numbers (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my @array = validate_input();
+
+        printf "Input:  \@array = (%s)\n", join ',', @array;
+
+        my $missing = find_missing_numbers( \@array );
+
+        printf "Output: (%s)\n", join ',', @$missing;
+    }
+}
+
+#------------------------------------------------------------------------------
+sub validate_input
+#------------------------------------------------------------------------------
+{
+    my %element_counts;
+
+    for (@ARGV)
+    {
+        / ^ $RE{num}{int} $ /x                       # Entry is a valid integer
+            or error( qq["$_" is not a valid integer] );
+
+        ++$element_counts{ $_ } == 1                          # Entry is unique
+            or error( "Duplicate ${_}s in the input array" )
+    }
+
+    return @ARGV;
+}
+
+#------------------------------------------------------------------------------
+sub find_missing_numbers
+#------------------------------------------------------------------------------
+{
+    my ($array) = @_;
+    my  $n      = scalar @$array;
+    my  @missing;
+
+    L_OUTER:
+    for my $m (0 .. $n)
+    {
+        for my $i (0 .. $#$array)
+        {
+            next L_OUTER if $array->[ $i ] == $m;
+        }
+
+        push @missing, $m;
+    }
+
+    return \@missing;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+#------------------------------------------------------------------------------
+sub run_tests
+#------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my ($test_name, $input, $expected) = split / \| /x, $line;
+
+        my @array   = split / , \s* /x, $input;
+        my $missing = find_missing_numbers( \@array );
+        my $got     = join ',', @$missing;
+
+        is $got, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+###############################################################################
+
+__DATA__
+Example 1| 0, 1, 3          |2
+Example 2| 0, 1             |2
+Multi    | 0, 1, 3, 5, 9, 10|2,4,6
+Negatives|-4,-3,-5, 4       |0,1,2,3
+Single   | 0                |1
+Evens    | 1, 3, 5, 7       |0,2,4
diff --git a/challenge-201/athanasius/perl/ch-2.pl b/challenge-201/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..b6ad01e22c
--- /dev/null
+++ b/challenge-201/athanasius/perl/ch-2.pl
@@ -0,0 +1,223 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 201
+=========================
+
+TASK #2
+-------
+*Penny Piles*
+
+Submitted by: Robbie Hatley
+
+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
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run.
+2. If $VERBOSE is set to a true value, then, providing $n is sufficiently small
+   (i.e., less than or equal to $MAX_N_ENUM), the output is followed by an
+   enumeration of the different possible partitions, as per the Example.
+
+Output Order
+------------
+Following the Example, partitions are ordered by number of piles, descending.
+Partitions with the same number of piles are ordered by the size (height) of
+the largest pile, ascending. Within each partition, piles are ordered by size,
+ascending.
+
+Solution
+--------
+The required solution is given by the partition function [1], an integer
+sequence [3] for which "No closed-form expression ... is known" but for which
+there are "recurrence relations by which it can be calculated exactly." [1]
+
+Rather than reinvent the wheel, I have chosen to use the CPAN module "Math::
+Prime::Util" [2] (also known as "ntheory") to perform the calculations:
+
+  1. if only the count of partitions is required, the subroutine Math::Prime::
+     Util::partitions() is used for maximum efficiency;
+  2. if an enumeration of the partitions is required, the subroutine Math::
+     Prime::Util::forpart() is used instead.
+
+See my Raku solution to Task 2 for a recursive approach that utilises Euler's
+recurrence relation. This latter solution, which uses no external modules, is
+much less efficient.
+
+References
+----------
+[1] "Partition function (number theory)", Wikipedia,
+     https://en.wikipedia.org/wiki/Partition_function_(number_theory)
+[2] "partitions", Math::Prime::Util,
+     https://metacpan.org/pod/Math::Prime::Util#partitions
+[3]  Sequence A000041, The On-Line Encyclopedia of Integer Sequences,
+     https://oeis.org/A000041
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use List::Util        qw( max );
+use Math::Prime::Util qw( forpart partitions );
+use Regexp::Common    qw( number );
+use Test::More;
+
+const my $VERBOSE     =>  1;
+const my $MAX_N_ENUM  => 13;
+const my $TEST_FIELDS =>  3;
+const my $USAGE       =>
+"Usage:
+  perl $0 <n>
+  perl $0
+
+    <n>    A positive integer\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 201, Task #2: Penny Piles (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $args = scalar @ARGV;
+
+    if    ($args == 0)
+    {
+        run_tests();
+    }
+    elsif ($args == 1)
+    {
+        my $n = $ARGV[ 0 ];
+           $n =~ / ^ $RE{num}{int} $ /x
+                or error( qq["$n" is not a valid integer] );
+
+        print  "Input:  \$n = $n\n";
+
+        if ($VERBOSE && $n <= $MAX_N_ENUM)
+        {
+            my $penny_piles = find_penny_piles( $n );
+            my $count       = scalar @$penny_piles;
+
+            printf "Output: %d\n\nThere are %d ways of stacking %d pennies " .
+                   "in ascending piles:\n\n    %s\n", $count, $count, $n,
+                    join( "\n    ", map { join ' ', @$_ } @$penny_piles );
+        }
+        else
+        {
+            printf "Output: %d\n", count_penny_piles( $n );
+        }
+    }
+    else
+    {
+        error( "Expected 1 or 0 arguments, found $args" );
+    }
+}
+
+#------------------------------------------------------------------------------
+sub count_penny_piles
+#------------------------------------------------------------------------------
+{
+    my ($n) = @_;
+
+    return partitions( $n );
+}
+
+#------------------------------------------------------------------------------
+sub find_penny_piles
+#------------------------------------------------------------------------------
+{
+    my ($n) = @_;
+    my  @penny_piles;
+
+    forpart
+    {
+        push @penny_piles, [ @_ ]
+
+    } $n;
+
+    @penny_piles = sort
+                   {
+                       scalar @$b   <=> scalar @$a ||
+                         max( @$a ) <=>   max( @$b )
+
+                   } @penny_piles;
+
+    return \@penny_piles;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+#------------------------------------------------------------------------------
+sub run_tests
+#------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my ($test_name, $n, $expected) = split / \| /x, $line, $TEST_FIELDS;
+
+        $n =~ s/ ^ \s* (.+?) \s* $ /$1/x;                     # Trim whitespace
+
+        is count_penny_piles( $n ), $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+###############################################################################
+
+__DATA__
+Example   | 5|7
+Smallest  | 1|1
+Small     |13|101
+Medium    |22|1002
+Large     |33|10143
+Very large|41|44583
+Huge      |70|4087968
diff --git a/challenge-201/athanasius/raku/ch-1.raku b/challenge-201/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..93ed87b881
--- /dev/null
+++ b/challenge-201/athanasius/raku/ch-1.raku
@@ -0,0 +1,171 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 201
+=========================
+
+TASK #1
+-------
+*Missing Numbers*
+
+Submitted by: Mohammad S Anwar
+
+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.
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. If the first argument is negative, it must be preceded by "--" to distin-
+   guish it from a command-line flag.
+
+Assumption
+----------
+Numbers in the input array are integers.
+
+=end comment
+#==============================================================================
+
+use Test;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 201, Task #1: Missing Numbers (Raku)\n".put;
+}
+
+#==============================================================================
+multi sub MAIN
+(
+    #| A list of 1 or more unique integers
+
+    *@array where { .elems >= 1 && .all ~~ Int:D && is-unique( @array ) }
+)
+#==============================================================================
+{
+    "Input:  \@array = (%s)\n".printf: @array.join: ',';
+
+    my Int @missing = find-missing-numbers( @array );
+
+    "Output: (%s)\n".printf: @missing.join: ',';
+}
+
+#==============================================================================
+multi sub MAIN()                                 # No input: run the test suite
+#==============================================================================
+{
+    run-tests();
+}
+
+#------------------------------------------------------------------------------
+sub find-missing-numbers( List:D[Int:D] $array --> List:D[Int:D] )
+#------------------------------------------------------------------------------
+{
+    my UInt $n = $array.elems;
+    my Int  @missing;
+
+    L-OUTER:
+    for 0 .. $n -> UInt $m
+    {
+        for 0 .. $array.end -> UInt $i
+        {
+            next L-OUTER if $array[ $i ] == $m;
+        }
+
+        @missing.push: $m;
+    }
+
+    return @missing;
+}
+
+#------------------------------------------------------------------------------
+sub is-unique( List:D[Int:D] $array --> Bool:D )
+#------------------------------------------------------------------------------
+{
+    my UInt %element-counts{Int};
+
+    for @$array -> Int $element
+    {
+        return False if ++%element-counts{ $element } > 1;
+    }
+
+    return True;
+}
+
+#------------------------------------------------------------------------------
+sub run-tests()
+#------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $input, $expected) = $line.split: / \| /;
+
+        my Int @array   = $input.split( / \, \s* / ).map: { .Int };
+        my Int @missing = find-missing-numbers( @array );
+        my Str $got     = @missing.join: ',';
+
+        is $got, $expected, $test-name;
+    }
+
+    done-testing;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+#------------------------------------------------------------------------------
+sub test-data( --> Str:D )
+#------------------------------------------------------------------------------
+{
+    return q:to/END/;
+        Example 1| 0, 1, 3          |2
+        Example 2| 0, 1             |2
+        Multi    | 0, 1, 3, 5, 9, 10|2,4,6
+        Negatives|-4,-3,-5, 4       |0,1,2,3
+        Single   | 0                |1
+        Evens    | 1, 3, 5, 7       |0,2,4
+        END
+}
+
+###############################################################################
diff --git a/challenge-201/athanasius/raku/ch-2.raku b/challenge-201/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..acc96e2bd7
--- /dev/null
+++ b/challenge-201/athanasius/raku/ch-2.raku
@@ -0,0 +1,185 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 201
+=========================
+
+TASK #2
+-------
+*Penny Piles*
+
+Submitted by: Robbie Hatley
+
+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
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Interface
+---------
+If no command-line argument is given, the test suite is run.
+
+Output Order
+------------
+Following the Example, partitions are ordered by number of piles, descending.
+Partitions with the same number of piles are ordered by the size (height) of
+the largest pile, ascending. Within each partition, piles are ordered by size,
+ascending.
+
+Solution
+--------
+The required solution is given by the partition function [1], an integer
+sequence [2] for which "No closed-form expression ... is known" but for which
+there are "recurrence relations by which it can be calculated exactly." [1]
+
+The solution implemented below uses recursion based on Euler's recurrence
+relation [1: "Recurrence relations"]. The required calculation time increases
+markedly as n increases.
+
+References
+----------
+[1] "Partition function (number theory)", Wikipedia,
+     https://en.wikipedia.org/wiki/Partition_function_(number_theory)
+[2]  Sequence A000041, The On-Line Encyclopedia of Integer Sequences,
+     https://oeis.org/A000041
+
+=end comment
+#==============================================================================
+
+use Test;
+
+subset Pos of Int where * > 0;
+
+my UInt constant $TEST-FIELDS = 3;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 201, Task #2: Penny Piles (Raku)\n".put;
+}
+
+#==============================================================================
+multi sub MAIN
+(
+    Pos:D $n                       #= A positive integer
+)
+#==============================================================================
+{
+    "Input:  \$n = $n".put;
+
+    "Output: %d\n".printf: count-penny-piles( $n );
+}
+
+#==============================================================================
+multi sub MAIN()                                 # No input: run the test suite
+#==============================================================================
+{
+    run-tests();
+}
+
+#------------------------------------------------------------------------------
+sub count-penny-piles( Int:D $n --> Int:D )
+#------------------------------------------------------------------------------
+{
+    # From [1: "Recurrence relations"]:
+    #
+    # p(n) = ∑ (-1)^(k + 1) × p(n - k(3k - 1)/2)
+    #      k∊Z\{0}
+    #
+    # Base cases: p(0) = 1
+    #             p(k) = 0 for all negative k
+    #
+    # k:    √(24n + 1) - 1       √(24n + 1) + 1
+    #     - -------------- ≤ k ≤ --------------
+    #             6                    6
+
+    return 0 if $n <  0;
+    return 1 if $n == 0;
+
+    my Num $root        = ((24 * $n) + 1).sqrt;
+    my Int $lower-bound = (-($root - 1) / 6).ceiling;
+    my Int $upper-bound = ( ($root + 1) / 6).floor;
+    my Int $p           = 0;
+
+    for $lower-bound .. $upper-bound -> Int $k
+    {
+        next if $k == 0;
+
+        $p += ((-1) ** ($k + 1)).Int *
+              count-penny-piles( $n - (($k * (3 * $k - 1)) / 2).Int );
+    }
+
+    return $p;
+}
+
+#------------------------------------------------------------------------------
+sub run-tests()
+#------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $n, $expected) =
+                $line.split: / \| /, $TEST-FIELDS;
+
+        my UInt $count = count-penny-piles( $n.Int );
+
+        is $count, $expected, $test-name;
+    }
+
+    done-testing;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+#------------------------------------------------------------------------------
+sub test-data( --> Str:D )
+#------------------------------------------------------------------------------
+{
+    return q:to/END/;
+        Example | 5|7
+        Smallest| 1|1
+        Small   |13|101
+        Medium  |22|1002
+        END
+}
+
+###############################################################################