laurent_r

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

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on January 15, 2023 at 23:59). This blog post offers some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Contrary to usual, I started with the Perl implementations this week (not having Raku installed on the computer where I started to work on the challenge). So I’ll present the Perl implementations first.

Task 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:
(0,3)
(0,4)
(3,4)
(2,5)

Example 2

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

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

Good pairs are below:
(0,1)
(0,2)
(0,3)
(1,2)
(1,3)
(2,3)

Good Pairs in Perl

The program uses two nested loops to get pairs ($i, $j) of indices in the proper range, in such a way that i < j. And it increments the $count variable whenever this index pair leads to equal values.

use strict;
use warnings;
use feature "say";

sub count_good_pairs {
    my @in = @_;
    my $count = 0;
    for my $i (0..$#in-1) {
        for my $j ($i+1..$#in) {
            $count++ if $in[$i] == $in[$j];
        }
    }
    return $count;
}

for my $test ( [1,2,3,1,1,3], [1,2,3], [1,1,1,1], 
               [1,2,3,1,2,3], [4,3,2,3,2,1] ) {
    say sprintf "%-15s => %d", "@$test", count_good_pairs @$test;
}

This program displays the following output:

$ perl ./good_pairs.pl
1 2 3 1 1 3     => 4
1 2 3           => 0
1 1 1 1         => 6
1 2 3 1 2 3     => 3
4 3 2 3 2 1     => 2

Good Pairs in Raku

This is a port to Raku of the Perl program above:

sub count_good_pairs (@in) {
    my $cnt = 0;
    for 0..^@in.end -> $i {
        $cnt++ if @in[$i] == @in[$_] for $i+1..@in.end;
    }
    return $cnt;
}

for <1 2 3 1 1 3>,  <1 2 3>,  <1 1 1 1>,   
    <1 2 3 1 2 3>,  <4 3 2 3 2 1> -> @test {
    say (~@test).fmt("%-15s => "), count_good_pairs @test;
}

This program displays the following output:

$ raku ./good_pairs.raku
1 2 3 1 1 3     => 4
1 2 3           => 0
1 1 1 1         => 6
1 2 3 1 2 3     => 3
4 3 2 3 2 1     => 2

Task 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

Good Triplets in Perl

The program works similarly to the Goof Pairs program. It uses three nested loops to get triplets ($i, $j, $k) of indices in the proper range, in such a way that i < j < k. And it increments the $count variable whenever this index triplet satisfies the conditions for $x,$y,$z.

sub count_good_triplets {
    my @in = @{$_[0]};
    my ($x, $y, $z) = @{$_[1]};
    my $count = 0;
    for my $i (0..$#in-2) {
        for my $j ($i+1..$#in-1) {
            # short-cut the $k loop if $i $j not good
            next if abs($in[$i] - $in[$j]) > $x;
            for my $k ($j+1..$#in) {
                $count++ if abs($in[$j] - $in[$k]) <= $y
                    and abs($in[$i] - $in[$k]) <= $z;
            }
        }
    }
    return $count;
}

for my $test ( [ [3,0,1,1,9,7], [7,2,3] ],
               [ [1,1,2,2,3], [0,0,1] ],
               [ [1,1,2,2,3], [1,1,2] ],
             ) {
    say sprintf "%-15s - xyz = %-10s => %d", 
                "@{@$test[0]}", "@{@$test[1]}", 
                count_good_triplets @$test;
}

This program displays the following output:

$ perl  ./good_triplets.pl
3 0 1 1 9 7     - xyz = 7 2 3      => 4
1 1 2 2 3       - xyz = 0 0 1      => 0
1 1 2 2 3       - xyz = 1 1 2      => 9

Good Triplets in Raku

This is a port to Raku of the above Perl program. Note that the management of nested data structures is significantly simpler and easier in Raku than in Perl.

sub count_good_triplets (@in, @xyz) {
    my $count = 0;
    my ($x, $y, $z) = @xyz;
    for 0..@in.end-2 -> $i {
        for $i+1..^@in.end -> $j {
            next if abs(@in[$i] - @in[$j]) > $x;
            for $j+1..@in.end -> $k {
                $count++ if abs(@in[$j] - @in[$k]) <= $y
                    && abs(@in[$i] - @in[$k]) <= $z;
            }
        }
    }
    return $count;
}

for ( <3 0 1 1 9 7>,  <7 2 3> ),
    ( <1 1 2 2 3>, <0 0 1> ),
    ( <1 1 2 2 3>, <1 1 2> ) -> @test {

    say sprintf "%-15s - xyz = %-10s => %d", 
                "@test[0]", "@test[1]", 
                count_good_triplets @test[0], @test[1];
}

This program displays the following output:

raku ./good_triplets.raku
3 0 1 1 9 7     - xyz = 7 2 3      => 4
1 1 2 2 3       - xyz = 0 0 1      => 0
1 1 2 2 3       - xyz = 1 1 2      => 9

Wrapping up

The next week Perl Weekly Challenge will 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 January 22, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.