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

On branch branch-for-challenge-061
Changes to be committed:
	new file:   challenge-061/athanasius/perl/ch-1.pl
	new file:   challenge-061/athanasius/perl/ch-2.pl
	new file:   challenge-061/athanasius/raku/ch-1.raku
	new file:   challenge-061/athanasius/raku/ch-2.raku

4 files changed, 504 insertions, 0 deletions

diff --git a/challenge-061/athanasius/perl/ch-1.pl b/challenge-061/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..f52a8f5c2a
--- /dev/null
+++ b/challenge-061/athanasius/perl/ch-1.pl
@@ -0,0 +1,107 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 061
+=========================
+
+Task #1
+-------
+*Product SubArray*
+
+*Reviewed by: Ryan Thompson*
+
+Given a list of *4 or more* numbers, write a script to find the contiguous
+sublist that has the maximum product. The length of the sublist is irrelevant;
+your job is to maximize the product.
+
+*Example*
+Input: [ 2, 5, -1, 3 ]
+
+Output: [ 2, 5 ] which gives maximum product 10.
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+use strict;
+use warnings;
+use Const::Fast;
+use Scalar::Util qw( looks_like_number );
+
+const my $MIN_ARGS => 4;
+const my $USAGE    => "USAGE: perl $0 <Number>{$MIN_ARGS+}";
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    print "Challenge 061, Task #1: Product SubArray (Perl)\n\n";
+
+    my $args =  scalar @ARGV;
+       $args >= $MIN_ARGS
+            or die "ERROR: Missing command-line arguments ($args found)\n\n" .
+                   "$USAGE\n";
+
+    looks_like_number($_) && !/ ^ NaN $ /ix
+            or die "ERROR: Invalid command-line argument: $_\n\n$USAGE\n"
+                for @ARGV;
+
+    my ($sublist, $product) = product_subarray(@ARGV);
+
+    printf "Input:  [%s]\nOutput: [%s] which gives maximum product %.1f\n",
+            join(', ', @ARGV), join(', ', @$sublist), $product;
+}
+
+#-------------------------------------------------------------------------------
+sub product_subarray
+#-------------------------------------------------------------------------------
+{
+    my @list        =  @_;
+    my @max_sublist = ($list[0]);
+    my $max_product =  $list[0];
+
+    for my $i (0 .. $#list)
+    {
+        my @sublist = ($list[$i]);
+        my $product =  $list[$i];
+
+        if (($product >  $max_product) ||
+            ($product == $max_product  &&
+             scalar @sublist < scalar @max_sublist))
+        {
+            @max_sublist = @sublist;
+            $max_product = $product;
+        }
+
+        for my $j ($i + 1 .. $#list)
+        {
+            push @sublist, $list[$j];
+            $product  *=   $list[$j];
+
+            if (($product >  $max_product) ||
+                ($product == $max_product  &&
+                 scalar @sublist < scalar @max_sublist))
+            {
+                @max_sublist = @sublist;
+                $max_product = $product;
+            }
+        }
+    }
+
+    return (\@max_sublist, $max_product);
+}
+
+################################################################################
diff --git a/challenge-061/athanasius/perl/ch-2.pl b/challenge-061/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..ce293cbd7d
--- /dev/null
+++ b/challenge-061/athanasius/perl/ch-2.pl
@@ -0,0 +1,170 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 061
+=========================
+
+Task #2
+-------
+*IPv4 Partition*
+
+*Reviewed by: Ryan Thompson*
+
+You are given a string containing only digits *(0..9)*. The string should have
+between *4* and *12* digits.
+
+Write a script to print every possible valid *IPv4* address that can be made by
+partitioning the input string.
+
+For the purpose of this challenge, a valid *IPv4* address consists of *four
+"octets"* i.e. *A*, *B*, *C* and *D*, separated by dots (.).
+
+Each octet must be between *0* and *255*, and must not have any leading zeroes.
+(e.g., *0* is OK, but *01* is not.)
+
+*Example*
+Input: 25525511135,
+
+Output:
+
+ 255.255.11.135
+ 255.255.111.35
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+use strict;
+use warnings;
+use Algorithm::Loops qw( NextPermuteNum );
+use Const::Fast;
+
+const my $USAGE =>
+    "USAGE: perl $0 <String>  --where <String> consists of 4-12 decimal digits";
+
+const my @PARTITIONS =>                                        #    No. Possible
+    (                                                          #      Partitions
+        [  [ 1, 1, 1, 1 ]  ],                                  #  4 digits:    1
+        [  [ 1, 1, 1, 2 ]  ],                                  #  5 digits:    4
+        [  [ 1, 1, 1, 3 ], [ 1, 1, 2, 2 ]  ],                  #  6 digits:   10
+        [  [ 1, 1, 2, 3 ], [ 1, 2, 2, 2 ]  ],                  #  7 digits:   16
+        [  [ 1, 1, 3, 3 ], [ 1, 2, 2, 3 ], [ 2, 2, 2, 2 ]  ],  #  8 digits:   19
+        [  [ 1, 2, 3, 3 ], [ 2, 2, 2, 3 ]  ],                  #  9 digits:   16
+        [  [ 1, 3, 3, 3 ], [ 2, 2, 3, 3 ]  ],                  # 10 digits:   10
+        [  [ 2, 3, 3, 3 ]  ],                                  # 11 digits:    4
+        [  [ 3, 3, 3, 3 ]  ],                                  # 12 digits:    1
+    );
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    print "Challenge 061, Task #2: IPv4 Partition (Perl)\n\n";
+
+    my $addresses = find_partitions( validate_input() );
+
+    if ((my $solutions = scalar @$addresses) == 0)
+    {
+        print  "The string \"$ARGV[0]\" cannot be partitioned into a valid " .
+               "IPv4 address\n";
+    }
+    else
+    {
+        printf "The string \"%s\" can be partitioned into %d valid IPv4 " .
+               "address%s:\n",
+                $ARGV[0], $solutions, ($solutions == 1 ? '' : 'es');
+
+        print  '  ', join('.', @$_), "\n" for sort by_address @$addresses;
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find_partitions
+#-------------------------------------------------------------------------------
+{
+    my ($digits) = @_;
+    my  @addresses;
+
+    for my $partition ( $PARTITIONS[ scalar @$digits - 4 ]->@* )
+    {
+        my @part = @$partition;         # a copy is needed here ...
+        my $loop = 1;
+
+        OUTER: while ($loop)
+        {
+            my @digits = @$digits;      # ... and also here
+            my @octets;
+
+            for my $i (0 .. 3)
+            {
+                my $octet  = '';
+                   $octet .= shift @digits for 1 .. $part[ $i ];
+
+                next OUTER if $octet > 255 ||
+                             (length $octet > 1 && substr($octet, 0, 1) eq '0');
+
+                push @octets, $octet;
+            }
+
+            push @addresses, \@octets;
+        }
+        continue
+        {
+            $loop = NextPermuteNum @part;
+        }
+    }
+
+    return \@addresses;
+}
+
+#-------------------------------------------------------------------------------
+sub validate_input
+#-------------------------------------------------------------------------------
+{
+    my $args = scalar @ARGV;
+       $args == 1  or error("Expected 1 command-line argument, found $args");
+
+    my @digits = split //, $ARGV[0];
+    my $digits = scalar @digits;
+
+    $digits >=  4  or error("Too few digits ($digits, expected at least 4)");
+    $digits <= 12  or error("Too many digits ($digits, expected at most 12)");
+
+    / ^ [0-9] $ /x or error("Character \"$_\" is not a decimal digit")
+        for @digits;
+
+    return \@digits;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($msg) = @_;
+
+    die "ERROR: $msg\n$USAGE\n";
+}
+
+#-------------------------------------------------------------------------------
+sub by_address
+#-------------------------------------------------------------------------------
+{
+    $a->[0] <=> $b->[0] || 
+    $a->[1] <=> $b->[1] ||
+    $a->[2] <=> $b->[2];
+}
+
+################################################################################
diff --git a/challenge-061/athanasius/raku/ch-1.raku b/challenge-061/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..16d78ee7e0
--- /dev/null
+++ b/challenge-061/athanasius/raku/ch-1.raku
@@ -0,0 +1,98 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 061
+=========================
+
+Task #1
+-------
+*Product SubArray*
+
+*Reviewed by: Ryan Thompson*
+
+Given a list of *4 or more* numbers, write a script to find the contiguous
+sublist that has the maximum product. The length of the sublist is irrelevant;
+your job is to maximize the product.
+
+*Example*
+Input: [ 2, 5, -1, 3 ]
+
+Output: [ 2, 5 ] which gives maximum product 10.
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+my UInt constant MIN-ARGS = 4;
+
+#-------------------------------------------------------------------------------
+BEGIN ''.put;
+#-------------------------------------------------------------------------------
+
+#===============================================================================
+sub MAIN
+(
+    #| 4 or more Real numbers (may include Inf, but not NaN)
+
+    *@nums where { $_.all ~~ Real:D && @nums.elems >= MIN-ARGS }
+)
+#===============================================================================
+{
+    "Challenge 061, Task #1: Product SubArray (Raku)\n".put;
+
+    my Array[Real] $list = Array[Real].new: @nums.map: { .Real };
+
+    $_ === NaN
+        and die "ERROR: Invalid command-line argument \"NaN\"\n$*USAGE\n"
+            for $list.values;
+
+    my (Array[Real] $sublist, Real $product) = product-subarray($list);
+
+    "Input:  [%s]\nOutput: [%s] which gives maximum product %.1f\n".printf:
+        $list.join(', '), $sublist.join(', '), $product;
+}
+
+#-------------------------------------------------------------------------------
+sub product-subarray( Array[Real] $list --> List )
+#-------------------------------------------------------------------------------
+{
+    my Array[Real] $max-sublist = Array[Real].new: $list[0];
+    my Real        $max-product = $list[0];
+
+    for $list.keys -> UInt $i
+    {
+        my Array[Real] $sublist = Array[Real].new: $list[$i];
+        my Real        $product = $list[$i];
+
+        if  $product >  $max-product ||
+           ($product == $max-product &&
+            $sublist.elems < $max-sublist.elems)
+        {
+            $max-sublist = $sublist.clone;
+            $max-product = $product;
+        }
+
+        for $i + 1 .. $list.end -> UInt $j
+        {
+            $sublist.push: $list[$j];
+            $product  *=   $list[$j];
+
+            if  $product >  $max-product ||
+               ($product == $max-product &&
+                $sublist.elems < $max-sublist.elems)
+            {
+                $max-sublist = $sublist.clone;
+                $max-product = $product;
+            }
+        }
+    }
+
+    return $max-sublist, $max-product;
+}
+
+###############################################################################
diff --git a/challenge-061/athanasius/raku/ch-2.raku b/challenge-061/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..fd85bbde1f
--- /dev/null
+++ b/challenge-061/athanasius/raku/ch-2.raku
@@ -0,0 +1,129 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 061
+=========================
+
+Task #2
+-------
+*IPv4 Partition*
+
+*Reviewed by: Ryan Thompson*
+
+You are given a string containing only digits *(0..9)*. The string should have
+between *4* and *12* digits.
+
+Write a script to print every possible valid *IPv4* address that can be made by
+partitioning the input string.
+
+For the purpose of this challenge, a valid *IPv4* address consists of *four
+"octets"* i.e. *A*, *B*, *C* and *D*, separated by dots (.).
+
+Each octet must be between *0* and *255*, and must not have any leading zeroes.
+(e.g., *0* is OK, but *01* is not.)
+
+*Example*
+Input: 25525511135,
+
+Output:
+
+ 255.255.11.135
+ 255.255.111.35
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+my constant PARTITION-TABLE =                                #      No. Possible
+   [                                                         #        Partitions
+       [  [ 1, 1, 1, 1 ], ],                                 #  4 digits:      1
+       [  [ 1, 1, 1, 2 ], ],                                 #  5 digits:      4
+       [  [ 1, 1, 1, 3 ], [ 1, 1, 2, 2 ]  ],                 #  6 digits:     10
+       [  [ 1, 1, 2, 3 ], [ 1, 2, 2, 2 ]  ],                 #  7 digits:     16
+       [  [ 1, 1, 3, 3 ], [ 1, 2, 2, 3 ], [ 2, 2, 2, 2 ]  ], #  8 digits:     19
+       [  [ 1, 2, 3, 3 ], [ 2, 2, 2, 3 ]  ],                 #  9 digits:     16
+       [  [ 1, 3, 3, 3 ], [ 2, 2, 3, 3 ]  ],                 # 10 digits:     10
+       [  [ 2, 3, 3, 3 ], ],                                 # 11 digits:      4
+       [  [ 3, 3, 3, 3 ], ],                                 # 12 digits:      1
+   ];
+
+#-------------------------------------------------------------------------------
+BEGIN ''.put;
+#-------------------------------------------------------------------------------
+
+#===============================================================================
+sub MAIN
+(
+    #| a string of 4-12 decimal digits
+
+    Str:D $str where { $str.chars >=  4 &&
+                       $str.chars <= 12 &&
+                       $str ~~ / ^ <[ 0 .. 9 ]>+ $ / }
+)
+#===============================================================================
+{
+    "Challenge 061, Task #2: IPv4 Partition (Raku)\n".put;
+
+    my Array[UInt] @addresses = find-partitions( $str );
+
+    if (my UInt $solns = @addresses.elems) == 0
+    {
+        "The string \"$str\" cannot be partitioned into a valid IPv4 address"
+            .put;
+    }
+    else
+    {
+        "The string \"%s\" can be partitioned into %d valid IPv4 address%s:\n"
+            .printf: $str, $solns, ($solns == 1 ?? '' !! 'es');
+
+        "  %s\n".printf: .join: '.' for @addresses.sort: { .chars, .Str };
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find-partitions( Str:D $str --> Array[Array[UInt]] )
+#-------------------------------------------------------------------------------
+{
+    my Array[UInt] @addresses;
+
+    for PARTITION-TABLE[ $str.chars - 4 ].list -> List $partition-template
+    {
+        # The Raku permutations() routine/method produces duplicates when the
+        # list elements are not unique. Here, duplicates are filtered out by
+        # assigning the permutations to a hash with keys formed by concatenation
+        # of the elements.
+
+        my %partitions;
+           %partitions{ .join: '' } = $_ for $partition-template.permutations;
+
+        my @partitions = %partitions.values;
+
+        LOOP: for @partitions -> List $partition
+        {
+            my UInt @digits = $str.split('', :skip-empty).map: { .UInt };
+            my UInt @octets;
+
+            for 0 .. 3 -> UInt $i
+            {
+                my Str $octet  = '';
+                       $octet ~= @digits.shift for 1 .. $partition[ $i ];
+
+                next LOOP if $octet > 255 ||
+                            ($octet.chars > 1 && $octet.substr(0, 1) eq '0');
+
+                @octets.push: $octet.UInt;
+            }
+
+            @addresses.push: @octets;
+        }
+    }
+
+    return @addresses;
+}
+
+################################################################################