Merge pull request #2863 from PerlMonk-Athanasius/branch-for-challenge-088

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

4 files changed, 870 insertions, 0 deletions

diff --git a/challenge-088/athanasius/perl/ch-1.pl b/challenge-088/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..fa9d0d86b7
--- /dev/null
+++ b/challenge-088/athanasius/perl/ch-1.pl
@@ -0,0 +1,136 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 088
+=========================
+
+Task #1
+-------
+*Array of Product*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of positive integers @N.
+
+Write a script to return an array @M where $M[i] is the product of all elements
+of @N except the index $N[i].
+
+Example 1:
+
+ Input:
+     @N = (5, 2, 1, 4, 3)
+ Output:
+     @M = (24, 60, 120, 30, 40)
+
+     $M[0] = 2 x 1 x 4 x 3 = 24
+     $M[1] = 5 x 1 x 4 x 3 = 60
+     $M[2] = 5 x 2 x 4 x 3 = 120
+     $M[3] = 5 x 2 x 1 x 3 = 30
+     $M[4] = 5 x 2 x 1 x 4 = 40
+
+Example 2:
+
+ Input:
+     @N = (2, 1, 4, 3)
+ Output:
+     @M = (12, 24, 6, 8)
+
+     $M[0] = 1 x 4 x 3 = 12
+     $M[1] = 2 x 4 x 3 = 24
+     $M[2] = 2 x 1 x 3 = 6
+     $M[3] = 2 x 1 x 4 = 8
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Assumption: "Positive" integers are those which are greater than zero.
+
+Algorithm:  First find $product, the product of *all* the elements in @N; then,
+            for each element in @N, divide $product by that element's value to
+            get the desired sub-product for that index, and store it in @M.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use List::Util     qw( reduce );
+use Regexp::Common qw( number );
+
+const my $USAGE =>
+"Usage:
+  perl $0 [<N> ...]
+
+    [<N> ...]    A non-empty, unsorted array of positive integers\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 088, Task #1: Array of Product (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my @N = parse_command_line();
+
+    print_array('Input',  \@N);
+
+    my   $product = reduce { $a * $b } @N;                     # List reduction
+    my   @M;
+    push @M, $product / $N[$_] for 0 .. $#N;
+
+    print_array('Output', \@M);
+}
+
+#------------------------------------------------------------------------------
+sub print_array
+#------------------------------------------------------------------------------
+{
+    my ($title, $array) = @_;
+
+    print  "$title:\n";
+
+    printf "    (%s)\n", join ', ', @$array;
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my @N = @ARGV;
+
+    scalar @N > 0           or error( 'The input array is empty' );
+
+    for (@N)
+    {
+        /\A$RE{num}{int}\z/ or error( qq["$_" is not an integer] );
+        $_ > 0              or error( qq["$_" is not positive]   );
+    }
+
+    return @N;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-088/athanasius/perl/ch-2.pl b/challenge-088/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..3b70506f65
--- /dev/null
+++ b/challenge-088/athanasius/perl/ch-2.pl
@@ -0,0 +1,327 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 088
+=========================
+
+Task #2
+-------
+*Spiral Matrix*
+
+Submitted by: Mohammad S Anwar
+
+You are given m x n matrix of positive integers.
+
+Write a script to print spiral matrix as list.
+
+Example 1:
+
+ Input:
+     [ 1, 2, 3 ]
+     [ 4, 5, 6 ]
+     [ 7, 8, 9 ]
+ Output:
+     [ 1, 2, 3, 6, 9, 8, 7, 4, 5 ]
+
+Example 2:
+
+ Input:
+     [  1,  2,  3,  4 ]
+     [  5,  6,  7,  8 ]
+     [  9, 10, 11, 12 ]
+     [ 13, 14, 15, 16 ]
+ Output:
+     [ 1, 2, 3, 4, 8, 12, 16, 15, 14, 13, 9, 5, 6, 7, 11, 10 ]
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Interface
+---------
+
+Two CLIs are provided:
+
+1.  For an m x n matrix in which the elements are 1 to m * n in left-to-right,
+    top-to-bottom order, the user may simply specify m and n explicitly; for
+    example:
+
+        perl ch-2.pl -m 4 -n 4
+
+    produces the matrix in Example 2.
+
+2.  For all other cases, the user must specify rows as whitespace-separated
+    strings, each string being a comma-separated list of elements; for example:
+
+        perl ch-2.pl  9,8,7  6,5,4  3,2,1
+
+    produces the matrix in Example 1, but with elements in reverse order.
+
+Algorithm
+---------
+
+1.  The outer elements of the matrix are read in clockwise order, beginning at
+    the top left corner:
+     - top row:      first to last columns
+     - right column: second to last rows
+     - bottom row:   second-last to first column
+     - left column:  second-last to second row.
+
+2.  A new, "inner" matrix is constructed by removing the outer rows and columns
+    of the current matrix.
+
+3.  Recursion: steps 1 and 2 above are applied to the new matrix. The recursion
+    ends when:
+     (1) the new matrix is a single row;    or
+     (2) the new matrix is a single column; or
+     (3) the new matrix is empty.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Getopt::Long;
+use Regexp::Common qw( number );
+
+const my $USAGE =>
+"Usage:
+  perl $0 [<rows> ...]
+  perl $0 [-m <Pos>] [-n <Pos>]
+
+    [<rows> ...]    One or more same-width rows, each a comma-separated list of
+one or more positive integers
+    -m <Pos>        Positive integer: matrix height (total number of rows)
+    -n <Pos>        Positive integer: matrix width (total number of columns)
+";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 088, Task #2: Spiral Matrix (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $matrix = get_matrix();
+
+    print "Input:\n";
+    print_matrix( $matrix );
+
+    my $spiral = find_spiral( $matrix );
+
+    print "Output:\n";
+    printf "    [ %s ]\n", join ' ', @$spiral;
+}
+
+#------------------------------------------------------------------------------
+sub find_spiral                                          # Recursive subroutine
+#------------------------------------------------------------------------------
+{
+    my ($matrix) = @_;
+    my  $max_row = $#$matrix;
+    my  $max_col = $#{ $matrix->[0] };
+    my  @spiral;
+
+    if    ($max_row == 0)                        # Base case (1): single row
+    {
+        push @spiral, @{ $matrix->[0] }[0 .. $max_col];
+    }
+    elsif ($max_col == 0)                        # Base case (2): single column
+    {
+        push @spiral, $matrix->[$_][0] for 0 .. $max_row;
+    }
+    else
+    {
+        # Step 1: Read the outer matrix elements in clockwise order, beginning
+        #         at the top left corner
+
+        my @top    =         0 .. $max_col;
+        my @right  =         1 .. $max_row;
+        my @bottom = reverse 0 .. $max_col - 1;
+        my @left   = reverse 1 .. $max_row - 1;
+
+        push @spiral, @{ $matrix->[0       ] }[@top    ];
+        push @spiral,    $matrix->[$_      ]  [$max_col] for @right;
+        push @spiral, @{ $matrix->[$max_row] }[@bottom ];
+        push @spiral,    $matrix->[$_      ]  [0       ] for @left;
+
+        # Step 2: Construct a new ("inner") matrix by removing the outer rows
+        #         and columns
+
+        my @new_matrix;
+
+        for my $row (1 .. $max_row - 1)
+        {
+            push @new_matrix, [ @{ $matrix->[$row] }[1 .. $max_col - 1] ];
+        }
+
+        if ($#new_matrix >= 0 && $#{ $new_matrix[0] } >= 0)
+        {
+            # Step 3: Recurse on the inner matrix
+
+            push @spiral, @{ find_spiral( \@new_matrix ) };
+        }
+      # else: Base case (3): the new matrix is empty
+    }
+
+    return \@spiral;
+}
+
+#------------------------------------------------------------------------------
+sub get_matrix
+#------------------------------------------------------------------------------
+{
+    scalar @ARGV > 0        or error( 'Missing input matrix' );
+
+    my ($m, $n);
+
+    GetOptions
+    (
+        "m:i" => \$m,
+        "n:i" => \$n,
+    )                       or error( 'Invalid command line argument(s)' );
+
+    my $matrix;
+
+    if (defined $m || defined $n)
+    {
+        scalar @ARGV == 0   or error( 'Extra command line argument(s) found' );
+
+        $matrix = construct_matrix( $m, $n );
+    }
+    else
+    {
+        $matrix = read_matrix( @ARGV );
+    }
+
+    return $matrix;
+}
+
+#------------------------------------------------------------------------------
+sub construct_matrix
+#------------------------------------------------------------------------------
+{
+    my ($m, $n) = @_;
+
+    defined $m                or error( 'Missing value for -m' );
+    defined $n                or error( 'Missing value for -n' );
+
+    $m =~ /\A$RE{num}{int}\z/ or error( "-m=$m is not an integer" );
+    $m > 0                    or error( "-m=$m is not positive"   );
+
+    $n =~ /\A$RE{num}{int}\z/ or error( "-n=$n is not an integer" );
+    $n > 0                    or error( "-n=$n is not positive"   );
+
+    my @matrix;
+    my $element = 1;
+
+    for my $row (0 .. $m - 1)
+    {
+        $matrix[$row] = [$element .. $element + $n - 1];
+
+        $element += $n;
+    }
+
+    return \@matrix;
+}
+
+#------------------------------------------------------------------------------
+sub read_matrix
+#------------------------------------------------------------------------------
+{
+    my @rows = @_;
+    my @matrix;
+    my $width;
+
+    for my $i (0 .. $#rows)
+    {
+        my $row  = $rows[$i];
+        my @nums = split /,/, $row;
+
+        if ($i == 0)
+        {
+            $width = scalar @nums;
+        }
+        else
+        {
+            scalar @nums == $width
+                or error( sprintf 'Inconsistent number of columns in row %d',
+                                   $i + 1 );
+        }
+
+        for (@nums)
+        {
+            /\A$RE{num}{int}\z/ or error( qq["$_" is not an integer] );
+            $_ > 0              or error( qq["$_" is not positive]   );
+
+            push @{ $matrix[$i] }, $_;
+        }
+    }
+
+    return \@matrix;
+}
+
+#------------------------------------------------------------------------------
+sub print_matrix
+#------------------------------------------------------------------------------
+{
+    my ($matrix) = @_;
+
+    # 1. Pre-compute the maximum width of each matrix column
+
+    my @widths;
+
+    for my $col (0 .. $#{ $matrix->[0] })
+    {
+        my $max_width = 0;
+
+        for my $row (0 .. $#$matrix)
+        {
+            my $width  = length $matrix->[$row][$col];
+            $max_width = $width if $width > $max_width;
+        }
+
+        $widths[$col] = $max_width;
+    }
+
+    # 2. Print the matrix
+
+    for my $row (0 .. $#$matrix)
+    {
+        my @vals;
+
+        for my $col (0 .. $#{ $matrix->[0] })
+        {
+            push @vals, sprintf '%*d', $widths[$col], $matrix->[$row][$col];
+        }
+
+        printf "    [ %s ]\n", join ' ', @vals;
+    }
+
+    print "\n";
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-088/athanasius/raku/ch-1.raku b/challenge-088/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..816a87eeaa
--- /dev/null
+++ b/challenge-088/athanasius/raku/ch-1.raku
@@ -0,0 +1,113 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 088
+=========================
+
+Task #1
+-------
+*Array of Product*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of positive integers @N.
+
+Write a script to return an array @M where $M[i] is the product of all elements
+of @N except the index $N[i].
+
+Example 1:
+
+ Input:
+     @N = (5, 2, 1, 4, 3)
+ Output:
+     @M = (24, 60, 120, 30, 40)
+
+     $M[0] = 2 x 1 x 4 x 3 = 24
+     $M[1] = 5 x 1 x 4 x 3 = 60
+     $M[2] = 5 x 2 x 4 x 3 = 120
+     $M[3] = 5 x 2 x 1 x 3 = 30
+     $M[4] = 5 x 2 x 1 x 4 = 40
+
+Example 2:
+
+ Input:
+     @N = (2, 1, 4, 3)
+ Output:
+     @M = (12, 24, 6, 8)
+
+     $M[0] = 1 x 4 x 3 = 12
+     $M[1] = 2 x 4 x 3 = 24
+     $M[2] = 2 x 1 x 3 = 6
+     $M[3] = 2 x 1 x 4 = 8
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Assumption: "Positive" integers are those which are greater than zero.
+
+Algorithm:  First find $product, the product of *all* the elements in @N; then,
+            for each element in @N, divide $product by that element's value to
+            get the desired sub-product for that index, and store it in @M.
+
+=end comment
+#==============================================================================
+
+subset Positive of Int where * > 0;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 088, Task #1: Array of Product (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    #| A non-empty, unsorted array of positive integers
+
+    *@N where { @N.elems > 0 && .all ~~ Positive:D }
+)
+#==============================================================================
+{
+    my Positive @n = @N;    # Change element containers from IntStr to Positive
+
+    print-array('Input',  @n);
+
+    my Positive $product = [*] @n;                     # List reduction
+    my Positive @M;
+
+    @M.push: $product div @n[$_] for 0 .. @n.end;      # Note: integer division
+
+    print-array('Output', @M);
+}
+
+#------------------------------------------------------------------------------
+sub print-array( Str:D $title, Array:D[Positive:D] $array )
+#------------------------------------------------------------------------------
+{
+    "$title:".put;
+
+    "    (%s)\n".printf: $array.join: ', ';
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+##############################################################################
diff --git a/challenge-088/athanasius/raku/ch-2.raku b/challenge-088/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..fea5eff575
--- /dev/null
+++ b/challenge-088/athanasius/raku/ch-2.raku
@@ -0,0 +1,294 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 088
+=========================
+
+Task #2
+-------
+*Spiral Matrix*
+
+Submitted by: Mohammad S Anwar
+
+You are given m x n matrix of positive integers.
+
+Write a script to print spiral matrix as list.
+
+Example 1:
+
+ Input:
+     [ 1, 2, 3 ]
+     [ 4, 5, 6 ]
+     [ 7, 8, 9 ]
+ Output:
+     [ 1, 2, 3, 6, 9, 8, 7, 4, 5 ]
+
+Example 2:
+
+ Input:
+     [  1,  2,  3,  4 ]
+     [  5,  6,  7,  8 ]
+     [  9, 10, 11, 12 ]
+     [ 13, 14, 15, 16 ]
+ Output:
+     [ 1, 2, 3, 4, 8, 12, 16, 15, 14, 13, 9, 5, 6, 7, 11, 10 ]
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Interface
+---------
+
+Two CLIs are provided:
+
+1.  For an m x n matrix in which the elements are 1 to m * n in left-to-right,
+    top-to-bottom order, the user may simply specify m and n explicitly; for
+    example:
+
+        raku ch-2.raku -m=4 -n=4
+
+    produces the matrix in Example 2.
+
+2.  For all other cases, the user must specify rows as whitespace-separated
+    strings, each string being a comma-separated list of elements; for example:
+
+        raku ch-2.raku  9,8,7  6,5,4  3,2,1
+
+    produces the matrix in Example 1, but with elements in reverse order.
+
+Algorithm
+---------
+
+1.  The outer elements of the matrix are read in clockwise order, beginning at
+    the top left corner:
+     - top row:      first to last columns
+     - right column: second to last rows
+     - bottom row:   second-last to first column
+     - left column:  second-last to second row.
+
+2.  A new, "inner" matrix is constructed by removing the outer rows and columns
+    of the current matrix.
+
+3.  Recursion: steps 1 and 2 above are applied to the new matrix. The recursion
+    ends when:
+     (1) the new matrix is a single row;    or
+     (2) the new matrix is a single column; or
+     (3) the new matrix is empty.
+
+=end comment
+#==============================================================================
+
+subset Pos of Int where * > 0;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 088, Task #2: Spiral Matrix (Raku)\n".put;
+}
+
+#==============================================================================
+multi sub MAIN
+(
+    #| One or more same-width rows, each a comma-separated list of one or more
+    #| positive integers
+
+    *@rows where { @rows.elems > 0 && @rows[0].chars > 0 }
+)
+#==============================================================================
+{
+    my Str        @str-rows = @rows;
+    my Array[Pos] @matrix   = get-matrix( @str-rows );
+
+    main( @matrix );
+}
+
+#==============================================================================
+multi sub MAIN
+(
+    Pos:D :$m,      #= Positive integer: matrix height (total number of rows)
+    Pos:D :$n       #= Positive integer: matrix width (total number of columns)
+)
+#==============================================================================
+{
+    my Array[Pos] @matrix;
+
+    my Pos $element = 1;
+
+    for 0 ..^ $m -> UInt $row
+    {
+        @matrix[$row] = Array[Pos].new( $element ..^ $element + $n );
+
+        $element += $n;
+    }
+
+    main( @matrix );
+}
+
+#------------------------------------------------------------------------------
+sub main( Array:D[Pos:D] @matrix )
+#------------------------------------------------------------------------------
+{
+    'Input:'.put;
+    print-matrix( @matrix );
+
+    my Pos @spiral = find-spiral( @matrix );
+
+    "\nOutput:".put;
+    "    [ %s ]\n".printf: @spiral.join: ' ';
+}
+
+#------------------------------------------------------------------------------
+sub find-spiral( Array:D[Array:D[Pos:D]] $matrix --> Array:D[Pos:D] )
+#------------------------------------------------------------------------------
+{
+    my Pos  @spiral;
+    my UInt $max-row = $matrix\  .end;
+    my UInt $max-col = $matrix[0].end;
+
+    if    $max-row == 0                          # Base case (1): single row
+    {
+        @spiral = $matrix[0; *];
+    }
+    elsif $max-col == 0                          # Base case (2): single column
+    {
+        @spiral = $matrix[*; 0];
+    }
+    else
+    {
+        # Step 1: Read the outer matrix elements in clockwise order, beginning
+        #         at the top left corner
+
+        @spiral.append: $matrix[ 0;               *               ];   # Top
+        @spiral.append: $matrix[ 1 .. $max-row;   $max-col        ];   # Right
+        @spiral.append: $matrix[ $max-row;        $max-col ^... 0 ];   # Bottom
+        @spiral.append: $matrix[ $max-row ^... 1; 0               ];   # Left
+
+        # Step 2: Construct a new ("inner") matrix by removing the outer rows
+        #         and columns
+
+        my Array[Pos] @new-matrix;
+
+        for 1 ..^ $max-row -> UInt $row
+        {
+            @new-matrix.push: Array[Pos].new( $matrix[$row; 1 ..^ $max-col] );
+        }
+
+        if @new-matrix.elems > 0 && @new-matrix[0].elems > 0
+        {
+            # Step 3: Recurse on the inner matrix
+
+            @spiral.append: find-spiral( @new-matrix );
+        }
+      # else: Base case (3): the new matrix is empty
+    }
+
+    return @spiral;
+}
+
+#------------------------------------------------------------------------------
+sub get-matrix( Str:D @rows --> Array:D[Array:D[Pos:D]] )
+#------------------------------------------------------------------------------
+{
+    my Array[Pos] @matrix[ @rows.elems ];
+    my UInt       $width;
+
+    for 0 .. @rows.end -> UInt $i
+    {
+        my Str $row   = @rows[$i];
+        my Str @words = $row.split: ',', :skip-empty;
+
+        if $i == 0
+        {
+            $width = @words.elems;
+        }
+        else
+        {
+            @words.elems == $width
+                or error( "Inconsistent number of columns in row { $i + 1 }" );
+        }
+
+        for @words -> Str $word
+        {
+            my Str $val = val( $word );
+
+            $val ~~ IntStr:D or error( qq["$word" is not an integer] );
+
+            my Int $num = $val.Int;
+
+            $num > 0         or error( qq["$num" is not positive] );
+
+            @matrix[$i].push: $num;
+        }
+    }
+
+    return @matrix;
+}
+
+#------------------------------------------------------------------------------
+sub print-matrix( Array:D[Pos:D] $matrix )
+#------------------------------------------------------------------------------
+{
+    # 1. Pre-compute the maximum width of each matrix column
+
+    my UInt @widths;
+
+    for 0 .. $matrix[0].end -> UInt $col
+    {
+        my UInt $max-width = 0;
+
+        for 0 .. $matrix.end -> UInt $row
+        {
+            my UInt $width = $matrix[$row; $col].chars;
+            $max-width     = $width if $width > $max-width;
+        }
+
+        @widths[$col] = $max-width;
+    }
+
+    # 2. Print the matrix
+
+    for 0 .. $matrix.end -> UInt $row
+    {
+        my Str @vals;
+
+        for 0 .. $matrix[0].end -> UInt $col
+        {
+            @vals.push: '%*d'.sprintf: @widths[$col], $matrix[$row; $col];
+        }
+
+        "    [ %s ]\n".printf: @vals.join: ' ';
+    }
+}
+
+#------------------------------------------------------------------------------
+sub error( Str:D $message )
+#------------------------------------------------------------------------------
+{
+    "ERROR: $message".put;
+
+    USAGE();
+
+    exit;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+###############################################################################