Perl Weekly Challenge 199.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 199.

Task 1: Good Pairs

Submitted by: Mohammad S Anwar
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)

A simple answer may be obtained by producing all combinations of two elements, filtering them out and counting them, which leads to a one-liner:

perl -MAlgorithm::Combinatorics=combinations -E '
@l=@ARGV; say join " ", @l, "->", 0+grep{$_->[0]==$_->[1]} combinations(\@l, 2) ' 1 2 3 1 1 3
perl -MAlgorithm::Combinatorics=combinations -E '
@l=@ARGV; say join " ", @l, "->", 0+grep{$_->[0]==$_->[1]} combinations(\@l, 2) ' 1 2 3
perl -MAlgorithm::Combinatorics=combinations -E '
@l=@ARGV; say join " ", @l, "->", 0+grep{$_->[0]==$_->[1]} combinations(\@l, 2) ' 1 1 1 1

Results:

1 2 3 1 1 3 -> 4
1 2 3 -> 0
1 1 1 1 -> 6

The full code is

 1  # Perl weekly challenge 199
 2  # Task 1:  Good Pairs. Searching all combinations
 3  #
 4  # See https://wlmb.github.io/2023/01/09/PWC199/#task-1-good-pairs
 5  use v5.36;
 6  use Algorithm::Combinatorics qw(combinations);
 7  say(<<~"FIN"), exit unless @ARGV >= 2;
 8      Usage: $0 N1 N2 [N3...]
 9      to find all good pairs from the set N1 N2...
10      FIN
11  say join " ", @ARGV, "->", 0+grep{$_->[0]==$_->[1]} combinations(\@ARGV, 2)

Example:

./ch-1.pl 1 2 3 1 1 3
./ch-1.pl 1 2 3
./ch-1.pl 1 1 1 1

Results:

1 2 3 1 1 3 -> 4
1 2 3 -> 0
1 1 1 1 -> 6

There is a much more efficient solution for large inputs. First I count how many times each value is repeated and then I calculate how many pairs I can make with those repeated elements. For n elements there are n(n-1)/2 pairs. Finally I sum those numbers of pairs. This yields the following one-liner:

perl -MList::MoreUtils=frequency -MList::Util=sum -E '
say join " ", @ARGV, "->", sum map {$_*($_-1)/2} values %{ {frequency @ARGV} }
' 1 2 3 1 1 3
perl -MList::MoreUtils=frequency -MList::Util=sum -E '
say join " ", @ARGV, "->", sum map {$_*($_-1)/2}  values %{ {frequency @ARGV} }
' 1 2 3
perl -MList::MoreUtils=frequency -MList::Util=sum -E '
say join " ", @ARGV, "->", sum map {$_*($_-1)/2}  values %{ {frequency @ARGV} }
' 1 1 1 1

Results:

1 2 3 1 1 3 -> 4
1 2 3 -> 0
1 1 1 1 -> 6

The full code is

 1  # Perl weekly challenge 199
 2  # Task 1:  Good Pairs. Calculating number of pairs for each distinct value .
 3  #
 4  # See https://wlmb.github.io/2023/01/09/PWC199/#task-1-good-pairs
 5  use v5.36;
 6  use List::Util qw(sum);
 7  use List::MoreUtils qw(frequency);
 8  say(<<~"FIN"), exit unless @ARGV >= 2;
 9      Usage: $0 N1 N2 [N3...]
10      to find all good pairs from the set N1 N2...
11      FIN
12  my %histogram=frequency @ARGV; # pairs of value=>repetitions
13  my @counts=values %histogram;
14  my @number_of_pairs=map {$_*($_-1)/2} @counts;
15  say join " ", @ARGV, "->", sum @number_of_pairs;

./ch-1a.pl 1 2 3 1 1 3
./ch-1a.pl 1 2 3
./ch-1a.pl 1 1 1 1

Results:

1 2 3 1 1 3 -> 4
1 2 3 -> 0
1 1 1 1 -> 6

Note: My original oneliner and the program ch-1.pl had a big mistake. Thanks to Carlos Oliveira for pointing it out.

Task 2: Good Triplets

Submitted by: Mohammad S Anwar
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

As in the previous task, there is a simple but maybe not quite efficient solution: generate all triplets and test for good ones. I assume @ARGV contains $x, $y $z followed by the array elements. This yields the two-liner:

perl -MAlgorithm::Combinatorics=combinations -E '
($x, $y, $z, @l)=@ARGV; say "$x $y $z: ", join " ", @l, "->", 0+grep
{($p,$q,$r)=@$_;-$x<=$p-$q<=$x&&-$y<=$q-$r<=$y&&-$z<=$r-$p<=$z}combinations(\@l,3)
' 7 2 3 3 0 1 1 9 7
perl -MAlgorithm::Combinatorics=combinations -E '
($x, $y, $z, @l)=@ARGV; say "$x $y $z: ", join " ", @l, "->",0+grep
{($p,$q,$r)=@$_;-$x<=$p-$q<=$x&&-$y<=$q-$r<=$y&&-$z<=$r-$p<=$z}combinations(\@l,3)
' 0 0 1 1 1 2 2 3

Results:

7 2 3: 3 0 1 1 9 7 -> 4
0 0 1: 1 1 2 2 3 -> 0

The corresponding full code is:

 1  # Perl weekly challenge 199
 2  # Task 2:  Good Triplets
 3  #
 4  # See https://wlmb.github.io/2023/01/09/PWC199/#task-2-good-triplets
 5  use v5.36;
 6  use Algorithm::Combinatorics qw(combinations);
 7  say(<<~"FIN"), exit unless @ARGV >= 6;
 8      Usage: $0 x y z N1 N2 N3 [N4...]
 9      to find all good pairs with given x y z from the set N1 N2 N3...
10      FIN
11  my ($x, $y, $z, @l)=@ARGV;
12  my $good=grep {
13      my ($p,$q,$r)=@$_;
14      -$x<=$p-$q<=$x&&-$y<=$q-$r<=$y&&-$z<=$r-$p<=$z
15  } combinations(\@l,3);
16  say "$x $y $z: @l-> $good";

Example:

./ch-2.pl 7 2 3 3 0 1 1 9 7
./ch-2.pl 0 0 1 1 1 2 2 3

Results:

7 2 3: 3 0 1 1 9 7-> 4
0 0 1: 1 1 2 2 3-> 0
Written on January 9, 2023