Perl & Raku solutions to Tasks 1 & 2 of the Perl Weekly Challenge #134

4 files changed, 515 insertions, 0 deletions

diff --git a/challenge-134/athanasius/perl/ch-1.pl b/challenge-134/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..5b4da5f5dc
--- /dev/null
+++ b/challenge-134/athanasius/perl/ch-1.pl
@@ -0,0 +1,123 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 134
+=========================
+
+TASK #1
+-------
+*Pandigital Numbers*
+
+Submitted by: Mohammad S Anwar
+
+Write a script to generate first 5 Pandigital Numbers in base 10.
+
+As per the [ https://en.wikipedia.org/wiki/Pandigital_number |wikipedia], it
+says:
+
+    A pandigital number is an integer that in a given base has among its
+    significant digits each digit used in the base at least once.
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Interface
+---------
+Is zero a "significant" digit?
+- if so,  then the base-10            pandigital numbers begin with 1023456789;
+- if not, then the base-10 "zeroless" pandigital numbers begin with  123456789.
+
+Since the definition is not specified in the Task description, the solution
+below accommodates both definitions. For zeroless pandigitals the script must
+be invoked with a --zeroless flag. If no flag is given, the script defaults to
+pandigital numbers in which the zero digit is included.
+
+Algorithm
+---------
+Permutations of the digits are generated in ascending numerical order.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Algorithm::Loops qw( NextPermuteNum );
+use Const::Fast;
+use Getopt::Long;
+
+const my $TARGET => 5;
+const my $USAGE  => "Usage:\n  perl $0 [--zeroless]\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 134, Task #1: Pandigital Numbers (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $zeroless = parse_command_line();
+
+    printf 'The first %d pandigital numbers in base 10 containing the ' .
+           "digits %d-9%s:\n\n", $TARGET,
+                                 $zeroless ? (1, ' (zeroless)') : (0, '');
+
+    my $count  = 0;
+    my @digits = $zeroless ? 1 .. 9 : 0 .. 9;
+
+    # For an explanation of the arcane syntax below, see:
+    #     https://perldoc.perl.org/perlsyn#Statement-Modifiers
+
+    LOOP:
+    {
+        do
+        {{
+            next if $digits[ 0 ] == 0;
+
+            printf "    %s\n", join '', @digits;
+
+            last LOOP if ++$count >= $TARGET;
+
+        }} while NextPermuteNum( @digits );
+    }
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $zeroless;
+
+    GetOptions( zeroless  => \$zeroless )
+            or error( 'Invalid command line argument' );
+
+    my $args = scalar @ARGV;
+       $args == 0
+            or error( "Expected 0 command line arguments, found $args" );
+
+    return $zeroless;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-134/athanasius/perl/ch-2.pl b/challenge-134/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..2bdd3f5faf
--- /dev/null
+++ b/challenge-134/athanasius/perl/ch-2.pl
@@ -0,0 +1,160 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 134
+=========================
+
+TASK #2
+-------
+*Distinct Terms Count*
+
+Submitted by: Mohammad S Anwar
+
+You are given 2 positive numbers, $m and $n.
+
+Write a script to generate multiplcation table and display count of distinct
+terms.
+
+Example 1
+
+ Input: $m = 3, $n = 3
+ Output:
+
+       x | 1 2 3
+       --+------
+       1 | 1 2 3
+       2 | 2 4 6
+       3 | 3 6 9
+
+ Distinct Terms: 1, 2, 3, 4, 6, 9
+ Count: 6
+
+Example 2
+
+ Input: $m = 3, $n = 5
+ Output:
+
+       x | 1  2  3  4  5
+       --+--------------
+       1 | 1  2  3  4  5
+       2 | 2  4  6  8 10
+       3 | 3  6  9 12 15
+
+ Distinct Terms: 1, 2, 3, 4, 5, 6, 8, 9, 10, 12, 15
+ Count: 11
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+use strict;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+
+const my $USAGE =>
+"Usage:
+  perl $0 <m> <n>
+
+    <m>    Maximum row number
+    <n>    Maximum column number\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 134, Task #2: Distinct Terms Count (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my ($m, $n) = parse_command_line();
+
+    print "Input: \$m = $m, \$n = $n\n";
+
+    my (@table, %terms);
+
+    for my $row (1 .. $m)
+    {
+        for my $col (1 .. $n)
+        {
+            my $product = $row * $col;
+
+            push @{ $table[ $row - 1 ] }, $product;
+
+            ++$terms{ $product };
+        }
+    }
+
+    print_table( $m, $n, \@table );
+
+    printf "\nDistinct Terms: %s\nCount: %d\n",
+        join( ', ', sort { $a <=> $b } keys %terms ), scalar keys %terms;
+}
+
+#------------------------------------------------------------------------------
+sub print_table
+#------------------------------------------------------------------------------
+{
+    my  ($m, $n, $table) = @_;
+    my   @widths;
+    push @widths, length $m;
+    push @widths, length $_ for @{ $table->[ $m - 1 ] };
+
+    my $width_sum  = 0;
+       $width_sum += $_ for @widths[ 1 .. $#widths ];
+
+    printf "\n      %*s |", $widths[ 0 ], 'x';
+
+    printf ' %*d', $widths[ $_ ], $_ for 1 .. $n;
+
+    printf "\n      %s+%s\n", '-' x ($widths[ 0 ] + 1),
+                              '-' x ($width_sum   + $n);
+
+    for my $row (1 .. $m)
+    {
+        printf '      %*s |', $widths[ 0 ], $table->[ $row - 1 ][ 0 ];
+
+        printf ' %*d', $widths[ $_ ], $table->[ $row - 1 ][ $_ - 1 ]
+            for 1 .. $n;
+
+        print "\n";
+    }
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $args = scalar @ARGV;
+       $args == 2 or error( "Expected 2 command line arguments, found $args" );
+
+    for (@ARGV)
+    {
+        / ^ $RE{num}{int} $ /x
+                  or error( qq["$_" is not a valid integer] );
+
+        $_ > 0    or error( qq["$_" is not a positive integer] );
+    }
+
+    return @ARGV;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-134/athanasius/raku/ch-1.raku b/challenge-134/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..0e4b23a69f
--- /dev/null
+++ b/challenge-134/athanasius/raku/ch-1.raku
@@ -0,0 +1,91 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 134
+=========================
+
+TASK #1
+-------
+*Pandigital Numbers*
+
+Submitted by: Mohammad S Anwar
+
+Write a script to generate first 5 Pandigital Numbers in base 10.
+
+As per the [ https://en.wikipedia.org/wiki/Pandigital_number |wikipedia], it
+says:
+
+    A pandigital number is an integer that in a given base has among its
+    significant digits each digit used in the base at least once.
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Interface
+---------
+Is zero a "significant" digit?
+- if so,  then the base-10            pandigital numbers begin with 1023456789;
+- if not, then the base-10 "zeroless" pandigital numbers begin with  123456789.
+
+Since the definition is not specified in the Task description, the solution
+below accommodates both definitions. For zeroless pandigitals the script must
+be invoked with a --zeroless flag. If no flag is given, the script defaults to
+pandigital numbers in which the zero digit is included.
+
+Algorithm
+---------
+Permutations of the digits are generated in ascending numerical order.
+
+=end comment
+#==============================================================================
+
+my UInt constant TARGET = 5;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 134, Task #1: Pandigital Numbers (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN( Bool:D :$zeroless = False )
+#==============================================================================
+{
+    ('The first %d pandigital numbers in base 10 containing the digits ' ~
+     "%d-9%s:\n\n").printf: TARGET, $zeroless ?? [1, ' (zeroless)'] !! [0, ''];
+
+    my UInt $count  = 0;
+    my UInt @digits = $zeroless ?? 1 .. 9 !! 0 .. 9;
+
+    for @digits.permutations -> List $perm
+    {
+        next if $perm[ 0 ] == 0;
+
+        "    %s\n".printf: $perm.join: '';
+
+        last if ++$count >= TARGET;
+    }
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+##############################################################################
diff --git a/challenge-134/athanasius/raku/ch-2.raku b/challenge-134/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..dedbd7da60
--- /dev/null
+++ b/challenge-134/athanasius/raku/ch-2.raku
@@ -0,0 +1,141 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 134
+=========================
+
+TASK #2
+-------
+*Distinct Terms Count*
+
+Submitted by: Mohammad S Anwar
+
+You are given 2 positive numbers, $m and $n.
+
+Write a script to generate multiplcation table and display count of distinct
+terms.
+
+Example 1
+
+ Input: $m = 3, $n = 3
+ Output:
+
+       x | 1 2 3
+       --+------
+       1 | 1 2 3
+       2 | 2 4 6
+       3 | 3 6 9
+
+ Distinct Terms: 1, 2, 3, 4, 6, 9
+ Count: 6
+
+Example 2
+
+ Input: $m = 3, $n = 5
+ Output:
+
+       x | 1  2  3  4  5
+       --+--------------
+       1 | 1  2  3  4  5
+       2 | 2  4  6  8 10
+       3 | 3  6  9 12 15
+
+ Distinct Terms: 1, 2, 3, 4, 5, 6, 8, 9, 10, 12, 15
+ Count: 11
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+subset Pos of Int where * > 0;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 134, Task #2: Distinct Terms Count (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    Pos:D $m,                     #= Maximum row    number
+    Pos:D $n                      #= Maximum column number
+)
+#==============================================================================
+{
+    "Input: \$m = $m, \$n = $n".put;
+
+    my Array[Pos] @table;
+    my       Pos  %terms;
+
+    for 1 .. $m -> Pos $row
+    {
+        push @table, Array[Pos].new;
+
+        for 1 .. $n -> Pos $col
+        {
+            my Pos $product = $row * $col;
+
+            @table[ $row - 1 ].push: $product;
+
+            ++%terms{ $product };
+        }
+    }
+
+    print-table( $m, $n, @table );
+
+    "\nDistinct Terms: %s\nCount: %d\n".printf:
+        %terms.keys.map( { .Int } ).sort.join( ', ' ), %terms.elems;
+}
+
+#------------------------------------------------------------------------------
+sub print-table
+(
+    Pos:D                 $m,
+    Pos:D                 $n,
+    Array:D[Array:D[Pos]] $table
+)
+#------------------------------------------------------------------------------
+{
+    my Pos @widths;
+
+    @widths.push: $m.chars;
+    @widths.push: .chars for $table[ $m - 1 ].list;
+
+    my UInt $width-sum  = 0;
+            $width-sum += $_ for @widths[ 1 .. @widths.end ];
+
+    "\n      %*s |".printf: @widths[ 0 ], 'x';
+
+    ' %*d'.printf: @widths[ $_ ], $_ for 1 .. $n;
+
+    "\n      %s+%s\n".printf: '-' x (@widths[ 0 ] + 1),
+                              '-' x ($width-sum   + $n);
+
+    for 1 .. $m -> Pos $row
+    {
+        '      %*s |'.printf: @widths[ 0 ], $table[ $row - 1; 0 ];
+
+        ' %*d'.printf: @widths[ $_ ], $table[ $row - 1; $_ - 1 ] for 1 .. $n;
+
+        ''.put;
+    }
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+##############################################################################