Merge pull request #6340 from PerlMonk-Athanasius/branch-for-challenge-170

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

4 files changed, 769 insertions, 0 deletions

diff --git a/challenge-170/athanasius/perl/ch-1.pl b/challenge-170/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..e9e732e38b
--- /dev/null
+++ b/challenge-170/athanasius/perl/ch-1.pl
@@ -0,0 +1,147 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 170
+=========================
+
+TASK #1
+-------
+*Primorial Numbers*
+
+Submitted by: Mohammad S Anwar
+
+Write a script to generate first 10 Primorial Numbers.
+
+
+    Primorial numbers are those formed by multiplying successive prime numbers.
+
+
+For example,
+
+ P(0) = 1    (1)
+ P(1) = 2    (1x2)
+ P(2) = 6    (1x2×3)
+ P(3) = 30   (1x2×3×5)
+ P(4) = 210  (1x2×3×5×7)
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Algorithm
+---------
+Primes are found by the extensible sieve of Eratosthenes used in the solution
+to Task 1 of Week 169.
+
+Each new primorial is found by multiplying the previous primorial by the next
+successive prime number.
+
+Table
+-----
+Primorial numbers (from [1]):
+     1, 2, 6, 30, 210, 2310, 30030, 510510, 9699690, 223092870, 6469693230,
+     200560490130, 7420738134810, 304250263527210, 13082761331670030,
+     614889782588491410, 32589158477190044730, 1922760350154212639070,
+     117288381359406970983270, 7858321551080267055879090
+
+References
+----------
+[1] "A002110  Primorial numbers (first definition): product of first n primes.
+     Sometimes written prime(n)#.", OEIS, https://oeis.org/A002110
+[2] "Primorial", Wikipedia, https://en.wikipedia.org/wiki/Primorial
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use feature qw( state );
+use Const::Fast;
+
+use constant TARGET => 10;
+
+use if TARGET > 16, 'bigint';
+
+const my $USAGE => "Usage:\n  perl $0\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 170, Task #1: Primorial Numbers (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $args = scalar @ARGV;
+       $args == 0
+            or die "Expected 0 command line arguments, found $args\n$USAGE";
+
+    my @primes;
+
+    for (my $digits = 1; scalar @primes < TARGET - 1; ++$digits)
+    {
+        push @primes, @{ get_primes( $digits ) };
+    }
+
+    my @primorials = (1);
+
+    for my $i (0 .. TARGET - 2)
+    {
+        push @primorials, $primorials[ -1 ] * $primes[ $i ];
+    }
+
+    printf "The first %d primorial numbers:\n%s\n",
+            TARGET, join ', ', @primorials;
+}
+
+#------------------------------------------------------------------------------
+sub get_primes                               # Extensible sieve of Eratosthenes
+#------------------------------------------------------------------------------
+{
+    my   ($digits)  = @_;
+    my    $max_idx  = 10 ** $digits - 1;
+    state @sieve    = ((0, 0), (1) x ($max_idx - 1));
+    my    $orig_end = $#sieve;
+    state $first    = 1;
+
+    if ($first || $max_idx > $orig_end)
+    {
+        push @sieve, (1) x ($max_idx - $orig_end) if !$first;    # Extend sieve
+
+        for my $i (0 .. int sqrt $max_idx)
+        {
+            if ($sieve[ $i ])                                    # Prime
+            {
+                my $start = $first ? 2 : int( ($orig_end + 1) / $i );
+
+                for my $j ($start .. int( $max_idx / $i ))
+                {
+                    $sieve[ $i * $j ] = 0;                       # Composite
+                }
+            }
+        }
+
+        $first = 0;
+    }
+
+    # @range contains all integers of the required number of digits:
+    # e.g., if $digits = 2 then @range = 10 .. 99
+
+    my @range = 10 ** ($digits - 1) .. $max_idx;
+
+    return [ grep { $sieve[ $_ ] } @range ];                  # Apply the sieve
+}
+
+###############################################################################
diff --git a/challenge-170/athanasius/perl/ch-2.pl b/challenge-170/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..495bcae578
--- /dev/null
+++ b/challenge-170/athanasius/perl/ch-2.pl
@@ -0,0 +1,242 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 170
+=========================
+
+TASK #2
+-------
+*Kronecker Product*
+
+Submitted by: Mohammad S Anwar
+
+You are given 2 matrices.
+
+Write a script to implement Kronecker Product on the given 2 matrices.
+
+For more information, please refer
+[ https://en.wikipedia.org/wiki/Kronecker_product |wikipedia page].
+
+
+For example,
+
+ A = [ 1 2 ]
+     [ 3 4 ]
+
+ B = [ 5 6 ]
+     [ 7 8 ]
+
+ A x B = [ 1 x [ 5 6 ]   2 x [ 5 6 ] ]
+         [     [ 7 8 ]       [ 7 8 ] ]
+         [ 3 x [ 5 6 ]   4 x [ 5 6 ] ]
+         [     [ 7 8 ]       [ 7 8 ] ]
+
+       = [ 1x5 1x6 2x5 2x6 ]
+         [ 1x7 1x8 2x7 2x8 ]
+         [ 3x5 3x6 4x5 4x6 ]
+         [ 3x7 3x8 4x7 4x8 ]
+
+       = [  5  6 10 12 ]
+         [  7  8 14 16 ]
+         [ 15 18 20 24 ]
+         [ 21 24 28 32 ]
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Interface
+---------
+Each of the two input matrices is entered on the command line as a string, with
+rows separated by vertical bars ("|"), and, within each row, real-number
+elements separated by commas. For example:
+
+    perl ch-1.pl "1,2|3,4" "5,6|7,8"
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+
+const my $USAGE =>
+"Usage:
+  perl $0 <A> <B>
+
+    <A>    Matrix A (string: columns separated by ',' and rows by '|')
+    <B>    Matrix B (string: columns separated by ',' and rows by '|')\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 170, Task #2: Kronecker Product (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my ($matrixA, $matrixB) = parse_command_line();
+
+    print sprint_matrix( 'A', $matrixA ), "\n",
+          sprint_matrix( 'B', $matrixB ), "\n";
+
+    my ($rowsA, $colsA) = (scalar @$matrixA, scalar @{ $matrixA->[ 0 ] });
+    my ($rowsB, $colsB) = (scalar @$matrixB, scalar @{ $matrixB->[ 0 ] });
+    my  @matrixK;
+
+    # Calculate the Kronecker product
+
+    for my $rowA (0 .. $rowsA - 1)
+    {
+        for my $colA (0 .. $colsA - 1)
+        {
+            for my $rowB (0 .. $rowsB - 1)
+            {
+                my $rowK = ($rowA * $rowsB) + $rowB;
+
+                for my $colB (0 .. $colsB - 1)
+                {
+                    my $colK = ($colA * $colsB) + $colB;
+
+                    $matrixK[ $rowK ][ $colK ] = $matrixA->[ $rowA ][ $colA ] *
+                                                 $matrixB->[ $rowB ][ $colB ];
+                }
+            }
+        }
+    }
+
+    print sprint_matrix( 'A x B', \@matrixK );
+}
+
+#------------------------------------------------------------------------------
+sub sprint_matrix
+#------------------------------------------------------------------------------
+{
+    my ($name, $matrix) = @_;
+    my  $str_matrix     = format_elements( $matrix );
+
+    my  $out =  sprintf "%s = [ %s ]\n",
+                         $name,   join ' ', @{ $str_matrix->[ 0  ] };
+
+    my  $prefix = ' ' x (length( $name ) + 3);
+
+    for my $i (1 .. $#$matrix)
+    {
+        $out .= sprintf "%s[ %s ]\n",
+                         $prefix, join ' ', @{ $str_matrix->[ $i ] };
+    }
+
+    return $out;
+}
+
+#------------------------------------------------------------------------------
+sub format_elements
+#------------------------------------------------------------------------------
+{
+    my ($matrix)    = @_;
+    my  @max_widths = get_widths( $matrix );       # Find maximum column widths
+
+    # Convert each element to a string and left-justify with spaces as required
+
+    my $col_end = scalar @{ $matrix->[ 0 ] } - 1;
+    my @new_matrix;
+
+    for my $row (0 .. $#$matrix)
+    {
+        for my $col (0 .. $col_end)
+        {
+            my $element = $matrix->[ $row ][ $col ];
+
+            $new_matrix[ $row ][ $col ] =
+                sprintf "% *s", $max_widths[ $col ], $element;
+        }
+    }
+
+    return \@new_matrix;
+}
+
+#------------------------------------------------------------------------------
+sub get_widths
+#------------------------------------------------------------------------------
+{
+    my ($matrix) = @_;
+    my  $col_end = scalar @{ $matrix->[ 0 ] } - 1;
+    my  @max_widths;
+
+    for my $col (0 .. $col_end)
+    {
+        my $max_width;
+
+        for my $row (0 .. $#$matrix)
+        {
+            my $width  = length $matrix->[ $row ][ $col ];
+            $max_width = $width if !defined $max_width || $width > $max_width;
+        }
+
+        push @max_widths, $max_width;
+    }
+
+    return @max_widths;
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $args = scalar @ARGV;
+       $args == 2
+            or die "Expected 2 command line arguments, found $args\n$USAGE";
+
+    my @matrices;
+
+    for my $i (0, 1)
+    {
+        my @row_strs = split /\|/, $ARGV[ $i ];
+        my @rows;
+
+        for my $j (0 .. $#row_strs)
+        {
+            my $row_str = $row_strs[ $j ];
+            my @cols = map { / ^ \s* (\S+) \s* $ /x } split /,/, $row_str;
+
+            $j > 0 && scalar @cols != scalar @{ $rows[ 0 ] }
+                    and error( 'Inconsistent number of columns in row' );
+
+            for my $element (@cols)
+            {
+                $element =~ / ^ $RE{num}{real} $ /x
+                    or  error( qq["$element" is not a valid real number] );
+            }
+
+            push @rows, \@cols;
+        }
+
+        $matrices[ $i ] = \@rows;
+    }
+
+    return @matrices;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-170/athanasius/raku/ch-1.raku b/challenge-170/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..dc8c43f217
--- /dev/null
+++ b/challenge-170/athanasius/raku/ch-1.raku
@@ -0,0 +1,98 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 170
+=========================
+
+TASK #1
+-------
+*Primorial Numbers*
+
+Submitted by: Mohammad S Anwar
+
+Write a script to generate first 10 Primorial Numbers.
+
+
+    Primorial numbers are those formed by multiplying successive prime numbers.
+
+
+For example,
+
+ P(0) = 1    (1)
+ P(1) = 2    (1x2)
+ P(2) = 6    (1x2×3)
+ P(3) = 30   (1x2×3×5)
+ P(4) = 210  (1x2×3×5×7)
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Algorithm
+---------
+Primes are found using Raku's in-built is-prime method.
+
+Each new primorial is found by multiplying the previous primorial by the next
+successive prime number.
+
+Table
+-----
+Primorial numbers (from [1]):
+     1, 2, 6, 30, 210, 2310, 30030, 510510, 9699690, 223092870, 6469693230,
+     200560490130, 7420738134810, 304250263527210, 13082761331670030,
+     614889782588491410, 32589158477190044730, 1922760350154212639070,
+     117288381359406970983270, 7858321551080267055879090
+
+References
+----------
+[1] "A002110  Primorial numbers (first definition): product of first n primes.
+     Sometimes written prime(n)#.", OEIS, https://oeis.org/A002110
+[2] "Primorial", Wikipedia, https://en.wikipedia.org/wiki/Primorial
+
+=end comment
+#==============================================================================
+
+my UInt constant $TARGET = 10;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 170, Task #1: Primorial Numbers (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN()
+#==============================================================================
+{
+    my UInt @primorials = 1;
+
+    loop (my $n = 2; +@primorials < $TARGET; ++$n)
+    {
+        @primorials.push: @primorials[ *-1 ] * $n if $n.is-prime;
+    }
+
+    "The first %d primorial numbers:\n%s\n".printf:
+        $TARGET, @primorials.join: ', ';
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+###############################################################################
diff --git a/challenge-170/athanasius/raku/ch-2.raku b/challenge-170/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..7af3113b90
--- /dev/null
+++ b/challenge-170/athanasius/raku/ch-2.raku
@@ -0,0 +1,282 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 170
+=========================
+
+TASK #2
+-------
+*Kronecker Product*
+
+Submitted by: Mohammad S Anwar
+
+You are given 2 matrices.
+
+Write a script to implement Kronecker Product on the given 2 matrices.
+
+For more information, please refer
+[ https://en.wikipedia.org/wiki/Kronecker_product |wikipedia page].
+
+
+For example,
+
+ A = [ 1 2 ]
+     [ 3 4 ]
+
+ B = [ 5 6 ]
+     [ 7 8 ]
+
+ A x B = [ 1 x [ 5 6 ]   2 x [ 5 6 ] ]
+         [     [ 7 8 ]       [ 7 8 ] ]
+         [ 3 x [ 5 6 ]   4 x [ 5 6 ] ]
+         [     [ 7 8 ]       [ 7 8 ] ]
+
+       = [ 1x5 1x6 2x5 2x6 ]
+         [ 1x7 1x8 2x7 2x8 ]
+         [ 3x5 3x6 4x5 4x6 ]
+         [ 3x7 3x8 4x7 4x8 ]
+
+       = [  5  6 10 12 ]
+         [  7  8 14 16 ]
+         [ 15 18 20 24 ]
+         [ 21 24 28 32 ]
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Interface
+---------
+Each of the two input matrices is entered on the command line as a string, with
+rows separated by vertical bars ("|"), and, within each row, real-number
+elements separated by commas. For example:
+
+    raku ch-1.raku "1,2|3,4" "5,6|7,8"
+
+=end comment
+#==============================================================================
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 170, Task #2: Kronecker Product (Raku)\n".put;
+}
+
+#------------------------------------------------------------------------------
+class X::Input is Exception
+#------------------------------------------------------------------------------
+{
+}
+
+#------------------------------------------------------------------------------
+class X::Input::Real is X::Input
+#------------------------------------------------------------------------------
+{
+    method message( --> Str:D )
+    {
+        return 'Invalid real number';
+    }
+}
+
+#------------------------------------------------------------------------------
+class X::Input::Columns is X::Input
+#------------------------------------------------------------------------------
+{
+    method message( --> Str:D )
+    {
+        return 'Inconsistent number of columns in row';
+    }
+}
+
+#==============================================================================
+sub MAIN
+(
+    Str:D $A,    #= Matrix A (string: columns separated by ',' and rows by '|')
+    Str:D $B     #= Matrix B (string: columns separated by ',' and rows by '|')
+)
+#==============================================================================
+{
+    my Array[Real] @matrix-A = build-matrix( $A );
+    my Array[Real] @matrix-B = build-matrix( $B );
+
+    "%s\n%s\n".printf: sprint-matrix( 'A', @matrix-A ),
+                       sprint-matrix( 'B', @matrix-B );
+
+    # Calculate the Kronecker product
+
+    my Array[Real] @matrix-K = kronecker( @matrix-A, @matrix-B );
+
+    sprint-matrix( 'A x B', @matrix-K ).print;
+
+    CATCH
+    {
+        when X::Input
+        {
+            $*ERR.put: 'ERROR: ' ~ .message;
+            USAGE();
+        }
+    }
+}
+
+#------------------------------------------------------------------------------
+sub kronecker
+(
+    Array:D[Array:D[Real:D]] $matrix-A,
+    Array:D[Array:D[Real:D]] $matrix-B,
+--> Array:D[Array:D[Real:D]]
+)
+#------------------------------------------------------------------------------
+{
+    my UInt ($rows-A, $cols-A) = +$matrix-A, +$matrix-A[ 0 ];
+    my UInt ($rows-B, $cols-B) = +$matrix-B, +$matrix-B[ 0 ];
+
+    my Array[Real] @matrix-K = Array[Array[Real]].new:
+                               Array[Real].new xx ($rows-A * $rows-B);
+
+    for 0 .. $rows-A - 1 -> UInt $row-A
+    {
+        for 0 .. $cols-A - 1 -> UInt $col-A
+        {
+            for 0 .. $rows-B - 1 -> UInt $row-B
+            {
+                my UInt $row-K = ($row-A * $rows-B) + $row-B;
+
+                for 0 .. $cols-B - 1 -> UInt $col-B
+                {
+                    my UInt $col-K = ($col-A * $cols-B) + $col-B;
+
+                    @matrix-K[ $row-K; $col-K ] = $matrix-A[ $row-A; $col-A ] *
+                                                  $matrix-B[ $row-B; $col-B ];
+                }
+            }
+        }
+    }
+
+    return @matrix-K;
+}
+
+#------------------------------------------------------------------------------
+sub build-matrix( Str:D $rep --> Array:D[Array:D[Real:D]] )
+#------------------------------------------------------------------------------
+{
+    my Array[Real] @matrix;
+    my Str         @row-strs = $rep.split: '|', :skip-empty;
+
+    for 0 .. @row-strs.end -> UInt $j
+    {
+        my Str  $row-str = @row-strs[ $j ];
+        my Real @cols;
+
+        try
+        {
+            @cols = $row-str.split( ',', :skip-empty ).map: { .Real };
+
+            CATCH
+            {
+                X::Input::Real.new.throw when X::Str::Numeric;
+            }
+        }
+
+        $j == 0 || +@cols == +@matrix[ 0 ] or X::Input::Columns.new.throw;
+
+        push @matrix, @cols;
+    }
+
+    return @matrix;
+}
+
+#------------------------------------------------------------------------------
+sub sprint-matrix( Str:D $name, Array:D[Array:D[Real:D]] $matrix --> Str:D )
+#------------------------------------------------------------------------------
+{
+    my Array[Str] @str-matrix = format-elements( $matrix );
+    my Str        $out        = "%s = [ %s ]\n".sprintf:
+                                 $name, @str-matrix[ 0 ].list.join: ' ';
+    my Str        $prefix     = ' ' x ($name.chars + 3);
+
+    for 1 .. $matrix.end -> UInt $i
+    {
+        $out ~= "%s\[ %s \]\n".sprintf:
+                 $prefix, @str-matrix[ $i ].list.join: ' ';
+    }
+
+    return $out;
+}
+
+#------------------------------------------------------------------------------
+sub format-elements
+(
+    Array:D[Array:D[Real:D]] $matrix
+--> Array:D[Array:D[Str:D]]
+)
+#------------------------------------------------------------------------------
+{
+    my UInt @max-widths = get-widths( $matrix );   # Find maximum column widths
+
+    # Convert each element to a string and left-justify with spaces as required
+
+    my Array[Str] @new-matrix;
+    my UInt       $col-end = $matrix[ 0 ].elems - 1;
+
+    for 0 .. $matrix.end -> UInt $row
+    {
+        my Str @new-row;
+
+        for 0 .. $col-end -> UInt $col
+        {
+            my Real $element = $matrix[ $row; $col ];
+
+            @new-row.push: "% *s".sprintf: @max-widths[ $col ], $element;
+        }
+
+        @new-matrix.push: @new-row;
+    }
+
+    return @new-matrix;
+}
+
+#------------------------------------------------------------------------------
+sub get-widths( Array:D[Array:D[Real:D]] $matrix --> Array:D[UInt:D] )
+#------------------------------------------------------------------------------
+{
+    my UInt @max-widths;
+    my UInt $col-end = $matrix[ 0 ].elems - 1;
+
+    for 0 .. $col-end -> UInt $col
+    {
+        my UInt $max-width;
+
+        for 0 .. $matrix.end -> UInt $row
+        {
+            my UInt $width = $matrix[ $row; $col ].Str.chars;
+
+            $max-width = $width if !$max-width.defined || $width > $max-width;
+        }
+
+        @max-widths.push: $max-width;
+    }
+
+    return @max-widths
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+###############################################################################