- Added solutions by Colin Crain.

6 files changed, 248 insertions, 0 deletions

diff --git a/challenge-061/colin-crain/blog.txt b/challenge-061/colin-crain/blog.txt
new file mode 100644
index 0000000000..d476158e6c
--- /dev/null
+++ b/challenge-061/colin-crain/blog.txt
@@ -0,0 +1 @@
+https://colincrain.wordpress.com/2020/05/23/produce-market-protocols/
diff --git a/challenge-061/colin-crain/perl/ch-1.pl b/challenge-061/colin-crain/perl/ch-1.pl
new file mode 100644
index 0000000000..9ee814a411
--- /dev/null
+++ b/challenge-061/colin-crain/perl/ch-1.pl
@@ -0,0 +1,122 @@
+use warnings;
+use strict;
+use feature ":5.26";
+
+## ## ## ## ## MAIN:
+
+my @array = @ARGV;
+
+my $product = product( @array );
+
+my $zeros = grep { $_ == 0 } @array;
+my $negs  = grep { $_ < 0 }  @array;
+my $max_products;
+
+## case 1, no zeros, even or no negatives, whole array result
+if ($product > 0) {
+    $max_products = \@array;
+}
+## case 2, odd number of negatives no 0s or single 0 no negs
+if ($product < 0 or ($zeros == 1 and $negs == 0)) {
+    ($max_products, $product) = divide_left_right( @array );
+}
+## case 3 we need to do it the hard way and compute all subarrays
+else {
+    ($max_products, $product) = find_max_product(make_all_sublists(@array));
+}
+
+print_output($max_products, $product );
+
+
+
+
+## ## ## ## ## SUBS:
+
+sub product {
+## calculate the reduction product
+## given a null list returns - inf (defined, but any value is greater)
+    my @list = @_;
+    return( - inf ) if scalar @list == 0;
+    my $product = 1;
+    $product *= $_ for @list;
+    return $product;
+}
+
+sub divide_left_right {
+## divides list into left and right sections
+## shifting off first negative from either side and
+## calculate product of remaining elements
+## solves for either odd count of negative numbers or single 0,
+## but not both together
+    my @array = @_;
+    my @max_sublists;
+    my $val = "inf";
+
+    my @left = @array;
+    $val = pop @left until $val <= 0;
+    my $left = product(@left);
+    my @right = @array;
+    do {$val = shift @right; } until $val <= 0;
+    my $right = product(@right);
+
+    if ($right > $left) {
+        @max_sublists = \@right;
+        $product      = $right;
+    }
+    elsif ($right == $left) {
+        @max_sublists = (\@right, \@left);
+        $product      = $right;
+    }
+    else {
+        @max_sublists = \@left;
+        $product      = $left;
+    }
+    return (\@max_sublists, $product);
+}
+
+sub make_all_sublists {
+## constructs all sublists as an array of array refs:
+## ex: [ [1], [1,2], [1,2,3], [2], [2,3], [3] ]
+    my @array = @_;
+    my @sublists;
+    my $end = scalar @array - 1;
+    for my $start ( 0..$end ) {
+        my @subset = ();
+        for my $idx ($start..$end) {
+            push @subset, $array[$idx];
+            my @copy = @subset;
+            push @sublists, \@copy;
+        }
+    }
+    return @sublists;
+}
+
+sub find_max_product {
+## iterate through array of array refs,
+## calc products and keeps track of maximums
+    my @output = @_;
+    my $max_product = - inf;
+    my @max_sublists;
+
+    for my $list ( @output){
+        my $product = product( @$list );
+        if ($product > $max_product) {
+            $max_product  = $product;
+            @max_sublists = ($list);
+        }
+        elsif ($product == $max_product) {
+            push @max_sublists, $list
+        }
+    }
+    return (\@max_sublists, $max_product);
+}
+
+sub print_output {
+## given list ref and product
+## prints output
+    my ($max_sublists, $product) = @_;
+
+    say "product  : ", $product;
+    say "subset(s): ";
+    say join ", ", $_->@* for $max_sublists->@*;
+}
diff --git a/challenge-061/colin-crain/perl/ch-2.pl b/challenge-061/colin-crain/perl/ch-2.pl
new file mode 100644
index 0000000000..d1bb7e6ac5
--- /dev/null
+++ b/challenge-061/colin-crain/perl/ch-2.pl
@@ -0,0 +1,35 @@
+use warnings;
+use strict;
+use feature ":5.26";
+
+## ## ## ## ## MAIN:
+
+my $str = shift @ARGV;
+my $len = length $str;
+
+ONE: for my $one ( 1..3 ) {
+    my $octet_A = substr($str, 0, $one);
+    last if $octet_A == 0 || $octet_A > 255;                           #1
+
+    TWO: for my $two ( 1..3 ) {
+        next ONE if $one+$two >= $len-1;                               #2
+        my $octet_B = substr($str, $one, $two);
+        next ONE if $octet_B == 0 || $octet_B > 255;                   #1
+
+        THREE: for my $three ( 1..3 ) {
+            next TWO if $one+$two+$three >= $len;                      #2
+            my $octet_C = substr($str, $one+$two, $three);
+            next TWO if $octet_C == 0 || $octet_C > 255;               #1
+
+            FOUR: for my $four ( 1..3 ) {
+                next THREE if $one+$two+$three+$four > $len;           #2
+                next if $one+$two+$three+$four < $len;                 #3
+                my $octet_D = substr($str, $one+$two+$three, $four);
+                next THREE if $octet_D == 0 || $octet_D > 255;         #1
+
+                say "$octet_A.$octet_B.$octet_C.$octet_D";             ## success!
+                next THREE;
+            }
+        }
+    }
+}
diff --git a/challenge-061/colin-crain/raku/ch-1.p6 b/challenge-061/colin-crain/raku/ch-1.p6
new file mode 100644
index 0000000000..7601b9bf88
--- /dev/null
+++ b/challenge-061/colin-crain/raku/ch-1.p6
@@ -0,0 +1,46 @@
+multi MAIN () {
+    say "Usage: produce_market.raku array[0] array[1] array[2] ...";
+}
+
+multi MAIN(*@array) {
+    my $product = [*] @array;
+    my $max_sublists = [];        ## we need to load up as an array of arrays
+    $max_sublists.push: @array;
+
+    if $product <= 0 {
+        ($product, $max_sublists) = find_max_product( make_all_sublists( @array ) );
+    }
+    print_output( $product, $max_sublists );
+}
+
+sub make_all_sublists (@array) {
+    my @sublists.append( [\,] $_ .. @array.end ) for ^@array;
+    return @sublists.deepmap( { @array[$_] } );
+}
+
+sub find_max_product (@output) {
+    ## iterate through array of array refs,
+    ## calc products and keeps track of maximums
+    my $max_product = -Inf;
+    my $max_sublists;
+
+    for @output -> $list {
+        my $product = [*] |$list;
+        if $product > $max_product {
+            $max_product = $product;
+            $max_sublists = [$list];
+        }
+        elsif $product == $max_product {
+            $max_sublists.append: $list;
+        }
+    }
+    return( $max_product, $max_sublists );
+}
+
+sub print_output ($max_product, @max_sublists) {
+    ## given list ref and product
+    ## prints output
+    say "product : ", $max_product;
+    say "sublist(s): ";
+    .say for @max_sublists;
+}
diff --git a/challenge-061/colin-crain/raku/ch-2.p6 b/challenge-061/colin-crain/raku/ch-2.p6
new file mode 100644
index 0000000000..5db5ae4901
--- /dev/null
+++ b/challenge-061/colin-crain/raku/ch-2.p6
@@ -0,0 +1,8 @@
+#!/usr/bin/env perl6
+
+sub MAIN( $str = "2552501135" ) {
+    my @matches = $str ~~ m:ex/ ^  ( \d ** 1..3
+                                        <?{ $/.Int <= 255 && $/ !~~ /^0\d/ }>
+                                    ) ** 4  $ /;
+    .flat.join(".").say for @matches;
+}
diff --git a/challenge-061/colin-crain/raku/ch-2a.p6 b/challenge-061/colin-crain/raku/ch-2a.p6
new file mode 100644
index 0000000000..1ddf9de947
--- /dev/null
+++ b/challenge-061/colin-crain/raku/ch-2a.p6
@@ -0,0 +1,36 @@
+sub MAIN($str = "552051139") {
+    my @solutions;
+    get_octet_set( $str.Int, @solutions );
+
+    .say for @solutions;
+}
+
+sub get_octet_set ($str, @solutions,  $prev = []) {
+    for 1 .. 3 -> $digits {
+        ## out if str is undef or substr would be beyond end    #2, #3
+        return if $str.chars - $digits < 0 || $prev.elems == 4;
+
+        my $list = $prev.clone;
+
+        ## get octet
+        my $octet = substr( $str, 0, $digits );
+
+        ## out if leading 0 or out of bounds                #1
+        return if $octet ~~ /^0\d/ || $octet > 255;
+
+        ## if this is the last octet log and return         # success here
+        if $list.elems == 3 && $str.chars == $digits {
+            $list.push: $octet;
+            @solutions.push: $list;
+            ## out: cannot have a longer solution
+            return;
+        }
+
+        ## crop str to remainder
+        my $cropped = substr( $str, $digits );
+        ## add octet to copy of list
+        my $newlist = $list.push: $octet;
+        ## descend
+        get_octet_set( $cropped, @solutions, $list );
+    }
+}