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