THE WEEKLY CHALLENGE – PERL & RAKU #61
TASK #1 › Product SubArray
Challenge 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.
Method
This week Ryan gives us another puzzle where you think you have one thing, but on examination what you hold in your hands is completely different. This challenge resembles a classic problem wherein we find the longest contiguous sublist of an array with the largest sum, only in this case we’re looking for the largest product. Unsurprisingly, as it turns out, under analysis the two problems are quite divergent.
The two problems do have certain commonalities, specifically that if the entirety of the input list is positive, the maximum sublist is the whole list, as every element added to the sublist simply increases the total. However the behavior after introducing negative numbers and zeros to the input is quite different:
- Negative numbers in a sublist under multiplication generally increase the absolute value of the product, but also flip the sign. The presence of a second negative number will of course flip the sign right back.
- Zeros under multiplication are the real game-changer, though. The presence of any 0 in a list under evaluation will render the product of that list 0, and no additional 0s, or for that matter any other number, will change this fact.
The number of contiguous subsets of an array is the triangular number of its length. This can be visualized by example in enumerating the possible sublists of an array length 4:
1 2 3 4
1 2 3
1 2
1
2 3 4
2 3
2
3 4
3
4We can see that the sublists starting at the first position have 4 variations, those at the 2nd position have 3, or (n-1) variations, the next (n-2), etcetera. The sum of this sequence is 4+3+2+1, being the sum of the n natural numbers from n to 1. The value of a given Triangular number n can be computed as
Tn = n (n+1) / 2
This polynomial growth in the number of possibilities is ok, but not great. Brute forcing a solution is certainly an option, but let’s see if we can do better. Some methods can be had to avoid a thorough computation.
One more point needs to be brought up, and that is that multiple sublists can total to the same maximum product. If we are to allow for this, the solution lists must be accumulated in a list of their own for output. The instructions do not specify whether to provide an example or all examples. We will choose to accommodate this for the most part, as explained below.
The obvious first step is to multiply out the array. If the product is positive, then either we have 0 or an even number of negative elements cancelling each other out. In either case, the whole list is our sole maximum and we are done.
Another short-circuit we can choose to implement is if there are an odd number of negative elements and no 0s in the list. In that case we can remove elements from one end of our list one at a time until we remove a negative element. Once this happens any remaining negatives in the list will cancel each other out, the product will become positive, and the whole of the remaining list will be a local maximum. Because we have no idea of the values of the list nor their placement, we will need to repeat this process from the opposing end as well and compare the results to find the greater. This process will also work to remove exactly one 0, as long as there are no negative numbers elsewhere to complicate things. As this method is linear, it will be much faster if we can use it. If the two lists, left and right are the same, both will be returned, but there remains the possibility of smaller sublists bounded by 1s that will escape being reported by this method: (1, 2, 3, 4, -1, 5) will produce (1, 2, 3, 4) = 24 yet the shorter list within, (2, 3, 4) will be missed. Because of the speed increase this might be preferable for long lists without 0s. Who knows what data we will have? So we leave it in for demonstration purposes.
For any other cases we will just bite the bullet, compute all the sublists and find the maximum. We can use a pair of nested loops to generate the necessary indices, then use these on our input array to construct sublists. A product()function1 takes a list and multiples it out
1hand-rolling a new product function here, when we have a perfectly good version in the core module List::Util is more than just me being unnecessarily thorough. When given an empty list what should this function return? List::Util::product() returns 1. This is generally what we would want; perhaps one could argue that ∀ x > 0 x0=1. But that isn’t actually what we have, and furthermore 00=NaN. In any case this breaks the divide_left_right algorithm under certain edge cases, such as (1, 1, 0). The null-set right hand list is evaluated to 1 and hence given the equivalent product to the left and both are returned. Really the best argument is that it should be simply undefined, but rather than deal with that value in numeric comparisons I have redefined the result as negative infinity, being defined but smaller than any other number.
Perl Solution
[colincrain:~/PWC]$ perl 61_1_produce_market.pl 5 55 23 -1 -1 0 2
product : 6325
subset(s):
5, 55, 23
5, 55, 23, -1, -1use 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->@*;
}
Raku Solution
For the Raku solution, we can streamline things quite a bit through the use of higher order functions. I can’t begin to express how much I enjoy using functions that take other functions as their arguments. It truly makes me smile to paint in broad strokes and not have to get bogged down in how exactly to apply some transformation to every part of a block of data, like a list or a hash. So what can we do? Glad you asked. Right off the bat, there’s no need to roll up a custom product() routine because we have the product metaoperator [*] to do that for us.2
my $product = [*] |$list;
Much cooler though is the opportunity to use the produce operator, which can be considered somewhat like a version of reduce that shows its work. Being a big fan of reduce, you can only imagine how pleasant it was to whip this one out. In its triangle metaoperator form, combined with a comma [\,] we have what is known as the the “triangular comma”, which will take a range and turn it into a list of lists of increasing size as more elements are tacked on. Put that in a loop and now the single line
my @sublists.append( [\,] $_..@array.end ) for ^@array;
creates the entire triangle-of-triangles list structure we saw demonstrated above. To understand the code remember that ^@array is a range type going from 0 to the size of @arrry - 1, so this is indeed similar to the pair of nested loops we implemented in Perl. At this point the sublists are populated with indices. After that a second step:
return @sublists.deepmap( {@array[$_]} );
swaps in the input array values for the indices we generated. But wait, didn’t we have a list of lists to start with? Aren’t we mapping the list objects, rather than the values within them a level below? Well, here we are using the .deepmap() function, which works similarly to the more familiar .map() but will descend recursively into the list structure to do the associating as required. Really, how cool is that?
I must admit I had a time with keeping track of the nested data structures in this one. In a way, things were easier to follow with explicit referencing and dereferencing in Perl 5. As it is it can be a little tricky figuring out where you are between the lists of lists and the containers they’re in. It’s not a deal-breaker or anything, but is something to watch out for, and dd is most definitely your friend here.
2Beyond being an interesting demonstration, I’m not quite convinced of the actual utility of the divide_left_right() shortcut we wired into the Perl version, so I’ve left it out of the code here. Hence the previous footnote, although still a valid discussion as [*] [] returns 1, has become moot. We will continue to bypass the calculations entirely if the initial product comes out positive, of course.
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;
}TASK #2 › IPv4 Partition
Challenge 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
Method
If we break down an IPv4 quad into four octets, each containing a maximum of three decimal digits, we get 3*3*3*3 partitions, or a whopping 81 combinations of digit counts. Normally a quadruple loop would be a big red flag, but as our constraints are well known it seems an obvious way to proceed.
Each loop we create copies a specific substring out of the input with length either 1, 2 or 3 digits long. Taken together they comprise our candidate octet at a given position. Within each loop a number of filters are applied: if the candidate is 0 or greater than 255 we jump out of the structure. Likewise if we’ve exhausted the length of the input string before completing the last octet.
The filters work in three ways, as labeled in the code below:
- Check to see if the octet is either out of bounds, or malformed. If the octet has either a leading 0 or is greater than 255, then the test fails, and adding another digit will never fix the problem. The correct action is to jump out of this loop back into the previous to try another combination.
- Check to see if we’ve used up the characters of our input string before we’ve finished constructing our last octet. If we won’t have at least one character in left in the input string to create a number by the time we get to the last octet there’s no point in continuing. Again adding another digit will only make this problem worse so the correct action is to jump back one loop and try again.
- If we are evaluating the last octet, check to see if this iteration perfectly exhausts the input string. If not, it cannot be a solution so we should try adding another digit in the next iteration in this loop.
If we are within the last loop and our candidate last octet is exactly the length of the remaining string, we have a winner! Our erstwhile traveller has survived its trials and run he gauntlet. That particular set of octets has passed the tests and so is written to STDOUT and we jump bacon loop to check the next combination.
The code is a bit repetitive, true, but it also has a certain grace in simplicity written this way. And the IPv4 standard isn’t going to change or anything. We could rewrite it recursively, but why, exactly? We’ll try that for the Raku version, but there’s no compelling reason to do it here. Grace and beauty in simplicity has value.
Perl Solution
[colincrain:~/PWC]$ perl 61_2_ip_fourly.pl 552051139
55.20.51.139
55.205.1.139
55.205.11.39
55.205.113.9use 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;
}
}
}
}
Raku Solution
When doing the Raku version, in my first approach I made a recursive version of the Perl code above. With a little added control-flow support for adding a subroutine to recurse, and containers to hold the data being passed around, the net result was only three lines shorter, at the cost of being a whole lot less obvious in its process. This, and using the wonderful higher order functions in the previous challenge, got me thinking about using a subtractive approach rather than additive: what if started with all possible arrangements of the string as octets and worked backwards from there? Can we even do that?
Well, when looking for a tool to divide up a string a good place to start is with regular expressions. And a good way to start the search for an appropriate regex is to talk it out, to voice what exactly we want from the matches. In this case, we want to match four groups of between one to three digits, starting at the beginning of the string and ending our last group at the end.
The Perl 5 RE engine only has the /g global search switch and won’t backtrack from a match end position, so the choices available for (\d{1,3}) are only whether match greedily or not. This won’t be up to the task of checking for 1 digit in the first group, then later trying 2, then 3. However astute readers of my missives may remember back in challenge #52, Step Up and Get Lucky, where I had the opportunity to use the new :exhaustive (short form :ex) adverb that the Raku designers have added to the mix. This option tells the engine to keep going back and looking for every possible arrangement of matches that fit the criteria, returning them as a list. With this in mind
m:ex/^ (\d ** 1..3) (\d ** 1..3) (\d ** 1..3) (\d ** 1..3) $/
does exactly what we asked for. The engine will go through each grouping, anchored to the two ends, looking for octets of size 1, then 2, then 3 for each of the 4 capture groups. With a little imagination we can see how this process exactly mimics the search behavior in the explicit loops we made before, only in this case the regex engine is doing all of the work on its own with one simple command.
Note the new way of establishing a quantifier: ** 1..3 now expresses a general quantifier, replacing the \d{1,3} form. But wait, there’s more: the new quantifier now works on atoms, rather than character classes, which means they will work on capture groupings. The above can now be rewritten
m:ex/^ (\d ** 1..3) ** 4 $/which will still return 4 groupings of matches of 1 to 3 digits. Nice. But it stands to reason one should be able to look at a candidate match and evaluate it against an arbitrary code test before deciding it passes muster, right? I had a look through the docs and found, why yes indeed of course one can do that. There’s a special regex operator <?{}> , and it’s called a regex boolean condition check. In the docs, the example given happens to be a match for an IPv4 address:
/ \d ** 1..3 <?{ $/.Int <= 255 && $/.Int >= 0 }> /If the expression inside the block evaluates to true, the match is allowed to continue. With a small modification to qualify values less than 256 and without a leading 0, our regex now looks like:
m:ex/ ^ ( \d ** 1..3 <?{ $/.Int <= 255 && $/ !~~ /^0\d/ }> ) ** 4 $ /;It concerned me that the inner regex here may cause some problems, like resetting $/, but it appears that value is nicely localized, as one would hope. But it’s good to know this is indeed the case.
Another nice feature of the revamped Raku regex engine in the event of a successful match, all the relevant data around that match is preserved after the fact in the object returned, and there is no need to act on $1, $2, etcetera right away. In the match objects returned by our search, the capture groups for the octets can be accessed by the .list method, which returns a list container. Calling .flat makes the call to .list implicit and dereferences this into the match strings instead of the outer container, which we can now manipulate directly with .join .
Our not-very-interesting Raku script has become quite interesting indeed! I’ve broken up the regex into parts to improve clarity, which is always a good idea. Here is the final script, in all it’s powerful, succinct glory:
#!/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;
}As an afterthought, the original recursive additive construction from validated octets can be viewed below, if anyone cares to have a look:
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 );
}
}
Programming Excursions in Perl and Raku 
One thought on “Produce Market Protocols”