# Perl Weekly Challenge 199.

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

``````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  #
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  #
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.

``````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  #
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