laurent_r

These are some answers to the Week 61 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a couple of days (May 24, 2020). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

Task 1: Max Sub-Array Product

Given a list of 4 or more numbers, write a script to find the contiguous sublist that has the maximum product.

Example:

Input: [ 2, 5, -1, 3 ]

Output: [ 2, 5 ] which gives maximum product 10.

Max Sub-Array Product in Raku

Let’s start with a simple loop over a list of indices, as we would do in most procedural programming languages. We loop over the existing indices of the input array, compute the product of each item with the next one, and store in the @max array the max product so far, as well as the two items that led to it:

use v6;

my @input = @*ARGS;
my @max = @input[0] * @input[1], @input[0], @input[1];
for 1..^@input.end -> $i {
    @max = @input[$i] * @input[$i+1], @input[$i], @input[$i+1]
        if @max[0] < @input[$i] * @input[$i+1];
}
say "Max product is @max[0] for values @max[1] and @max[2]";

This is an example run of this program:

$ perl6 max-product.p6 3 5 7 9 3 6 12 4
Max product is 72 for values 6 and 12

But, Raku being what it is, we can use its expressive power to design a much better (or, at least, much shorter) solution:

use v6;

say @*ARGS.rotor(2 => -1).max({$_[0] * $_[1]});

We use the rotor built-in method to generate a list of overlapping 2-item seqs. For example, with an input of 3 5 7 9, rotor(2 => -1) generates the following list: ((3 5) (5 7) (7 9)). Then we use the max built-in method to find the 2-item seq having the largest product.

These are two sample runs of this one-liner program:

$ perl6 max-product2.p6 3 5 7 9 3 6 12 4
(6 12)

$ perl6 max-product2.p6 3 5 7 9 3 6 12 4 85 3
(4 85)

Max Sub-Array Product in Perl

Perl doesn’t have the built-ins used in our second Raku solution. So we will simply port to Perl the first Raku solution:

use strict;
use warnings;
use feature qw /say/;

my @input = @ARGV;
die "please supply at least two integers" if @input < 2;
my @max = ($input[0] * $input[1], $input[0], $input[1]);
for my $i (1..$#input) {
    @max = ($input[$i] * $input[$i+1], $input[$i], $input[$i+1])
        if $max[0] < $input[$i] * $input[$i+1];
}
say "Max product is $max[0] for values $max[1] and $max[2]";

Example runs:

$ perl max-product.pl 3 5 7 9 3 6 12 4
Max product is 72 for values 6 and 12

$ perl max-product.pl 3 5 7 9 3 6 12 4 85 3
Max product is 340 for values 4 and 85

Task 2: IPv4 Address Partitions

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

IPv4 Address Partitions in Raku

Here again, we could build a procedural solution as we would probably do in most programming languages (and as we will do in Perl below).

But we can again use Raku’s expressive power to design a simpler solution. In this case, we’ll use regexes.

Using the :exhaustive (or :ex) adverb makes it possible to generate all possible matches of a pattern.

To start with, we will define a regex subpattern to match an octet. I would normally write a subpattern looking like this:

my $octet = rx{(\d ** 1..3) <?{0 <= $0 <= 255}>};

This basically says Raku to match a number of 1 to 3 digits comprised between 0 and 255. The <?{0 <= $0 <= 255}> is a code assertion within the pattern to limit the value of an octet to the 0..255 range. But, for some reason, the task specification says that an octet should not start with 0 (unless the octet is 0 itself). So, our subpattern will be a little bit more complicated (see below). In the rest of the code, we use the :ex adverb to generate all partitions matching four times the $octet subppattern:

use v6;

my $octet = rx {( || 0
                  || <[ 1..9 ]> \d ** 0..2 
                ) <?{0 <= $0 <= 255}>
               };
sub MAIN (Int $in = 122202128) {
    for $in ~~ m:ex/^ (<$octet>) ** 4 $/ -> $match {
        say join ".", $match[0];
    }
}

These are a few sample runs:

$ perl6 ip.p6
122.202.12.8
122.202.1.28
122.20.212.8
122.20.21.28
122.20.2.128
12.220.212.8
12.220.21.28
12.220.2.128
12.2.202.128
1.22.202.128

$ perl6 ip.p6 2765645
27.65.64.5
27.65.6.45
27.6.56.45
2.76.56.45

$ perl6 ip.p6 12345678
123.45.67.8
123.45.6.78
123.4.56.78
12.34.56.78
1.234.56.78

$ perl6 ip.p6 122022128
122.0.221.28
122.0.22.128
12.202.212.8
12.202.21.28
12.202.2.128
12.20.221.28
12.20.22.128
1.220.221.28
1.220.22.128

IPv4 Address Partitions in Perl

We use the recursive partition subroutine to generate all possible partitions of the input numeric string that match the octet specification:

use strict;
use warnings;
use feature qw /say/;

sub partition {
    my ($out, @in) = @_;
    for my $nb_digits (0..2) {
        return if $nb_digits > $#in;
        my $num = join "", @in[0..$nb_digits];
        return if $num > 255;
        return if $num =~ /^0\d/;
        my @left_digits = @in[$nb_digits+1..$#in];
        my $new_out = $out eq "" ? $num : ($out . ".$num");
        if (@left_digits == 0) {
            say $new_out if $new_out =~ /^\d+\.\d+\.\d+\.\d+$/;
            return;
        }
        partition ($new_out, @left_digits);
    }
}

my $in = shift // 25525511135;
my @digits = split //, $in;
partition "", @digits;

Here are a few example runs of this program:

$ perl ip.pl
255.255.11.135
255.255.111.35

$ perl ip.pl 2765645
2.76.56.45
27.6.56.45
27.65.6.45
27.65.64.5

$ perl ip.pl 122202128
1.22.202.128
12.2.202.128
12.220.2.128
12.220.21.28
12.220.212.8
122.20.2.128
122.20.21.28
122.20.212.8
122.202.1.28
122.202.12.8

$ perl ip.pl 12345678
1.234.56.78
12.34.56.78
123.4.56.78
123.45.6.78
123.45.67.8

Wrapping up

The next week Perl Weekly Challenge is due to start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on Sunday, May 31, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.