aboutsummaryrefslogtreecommitdiff
path: root/challenge-201/athanasius/perl
diff options
context:
space:
mode:
Diffstat (limited to 'challenge-201/athanasius/perl')
-rw-r--r--challenge-201/athanasius/perl/ch-1.pl177
-rw-r--r--challenge-201/athanasius/perl/ch-2.pl223
2 files changed, 400 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
generated by cgit (git 2.34.1) at 2026-07-18 07:33:50 +0000