Perl Weekly Challenge: Week 199

Challenge 1:

Good Pairs

You are given a list of integers, @list.

Write a script to find the total count of Good Pairs.

A pair (i, j) is called good if list[i] == list[j] and i < j.

Example 1
Input: @list = (1,2,3,1,1,3)
Output: 4

There are 4 good pairs found as below:
Example 2
Input: @list = (1,2,3)
Output: 0
Example 3
Input: @list = (1,1,1,1)
Output: 6

Good pairs are below:

I start by declaring an array to hold any good pairs we may find. Actually, there is no need to store the pairs, the spec merely wants us to count them but I found this useful for debugging.

my @goodpairs;

Then we go through the @list looking at consecutive pairs of elements. The way this is done in a double loop ensures that $i is always less than $j as the spec requires.

for 0 .. @list.end -> $i {
    for $i ^.. @list.end -> $j {

If a good pair is found, it is added to @goodpairs.

        if @list[$j] == @list[$i] {
            @goodpairs.push(($i, $j));

Finally we just need to print how many pairs are in @goodpairs.


(Full code on Github.)

This is the Perl version.

my @goodpairs;

for my $i (0 .. scalar @list - 1) {
    for my $j ($i + 1 .. scalar @list - 1) {
        if ($list[$j] == $list[$i]) {
            push @goodpairs, [$i, $j];

say scalar @goodpairs;

(Full code on Github.)

Challenge 2:

Good Triplets

You are given an array of integers, @array and three integers $x,$y,$z.

Write a script to find out total Good Triplets in the given array.

A triplet array[i], array[j], array[k] is good if it satisfies the following conditions:

a) 0 <= i < j < k <= n (size of given array)
b) abs(array[i] - array[j]) <= x
c) abs(array[j] - array[k]) <= y
d) abs(array[i] - array[k]) <= z
Example 1
Input: @array = (3,0,1,1,9,7) and $x = 7, $y = 2, $z = 3
Output: 4

Good Triplets are as below:
(3,0,1) where (i=0, j=1, k=2)
(3,0,1) where (i=0, j=1, k=3)
(3,1,1) where (i=0, j=2, k=3)
(0,1,1) where (i=1, j=2, k=3)
Example 2
Input: @array = (1,1,2,2,3) and $x = 0, $y = 0, $z = 1
Output: 0

Now we have to do one better and find good triplets.

An interesting part of solving this challenge was entering input on the command line. I decided I would have three required named parameters to my script, -x, -y and -z and the rest of the arguments (there should be atleast one) would be the @array. Raku has some inbuilt functionality which allows us to build this quite easily. The first line defines the arguments. : in front means this is a named parameter. The * in front of @array, "slurps" all remaining command line arguments into it. The where clause in the second line validates these parameters making sure they are present and @array has at least one element. If there are any problems, the script will die and display a usage message which is also generated by Raku itself.

sub MAIN(
    Int :$x, Int :$y, Int :$z, *@array
    where { defined $x && defined $y && defined $z && @array.elems }

Perl is more complicated. We have to use a module for command line parsing. I chose Getopt::Long as that is bundled with Perl.

This line is equivalent to the first line in the Raku example.

GetOptions("x=i" => \$x, "y=i" => \$y, "z=i" => \$z, '<>' => sub { push @array, shift; });

And alll this is equivalent to the where clause in Raku. We also have to provide our own usage message.

for ($x, $y, $z) {
    defined($_) || usage()
scalar @array || usage();

Back to Raku, this works basically the same as challenge 1 except this time we have three nested loops ensuring $i < $j < $k.

my @goodtriplets;

for 0 .. @array.end -> $i {
    for $i ^.. @array.end -> $j {
        for $j ^.. @array.end -> $k {

Each set of three elements is checked to see if it meets the criteria in the spec...

            if (@array[$i] - @array[$j]).abs <= $x &&
            (@array[$j] - @array[$k]).abs <= $y &&
            (@array[$i] - @array[$k]).abs <= $z {

...and if it does, it is added to @goodtriplets.


Once again we just print how many triplets are in @goodtriplets.


(Full code on Github.)

This is the Perl version.

my @goodtriplets;
my ($x, $y, $z);
my @array;

for my $i (0 .. scalar @array - 1) {
    for my $j ($i + 1 .. scalar @array - 1) {
        for my $k ($j + 1 .. scalar @array - 1) {
            if ((abs($array[$i] - $array[$j]) <= $x) &&
            (abs($array[$j] - $array[$k]) <= $y) &&
            (abs($array[$i] - $array[$k]) <= $z)) {
                    push @goodtriplets, [$i, $j, $k];

say scalar @goodtriplets;

(Full code on Github.)