Perl Weekly Challenge 127.
My solutions (task 1, and task 2 ) to the The Weekly Challenge - 127.
Task 1: Disjoint Sets
Submitted by: Mohammad S Anwar
You are given two sets with unique integers.
Write a script to figure out if they are disjoint.
The two sets are disjoint if they don’t have any common
members.
Example
Input: @S1 = (1, 2, 5, 3, 4)
@S2 = (4, 6, 7, 8, 9)
Output: 0 as the given two sets have common member 4.
Input: @S1 = (1, 3, 5, 7, 9)
@S2 = (0, 2, 4, 6, 8)
Output: 1 as the given two sets do not have common member.
Assuming the sets are given by numbers, as in the examples
above, there is a nice solution using the Perl Data Language
PDL. If Ii are the members of the first set and
Jj the members of the second, then the sets are disjoint provided
all the elements of the matrix Mij=Ii-Jj are
different from zero. PDL allows to easily promote a vector
Jj to a matrix Qij=Ij (for any i) by adding dummy
dimensions. Then, it may be subtracted from I, which
is automátically promoted to a matrix Pij=Ii
and check the results for the presence of a zero entry. This
fits into a one-liner.
Example 1:
perl -MPDL -E '($I,$J)= map {pdl $_} @ARGV;
say "Input:\n\t$I\n\t$J\nOutput: ",
($I-$J->dummy(0))->all' \
"[1,2,5,3,4]" "[4,6,7,8,9]"
Results:
Input:
[1 2 5 3 4]
[4 6 7 8 9]
Output: 0
Example 2:
perl -MPDL -E '($I,$J)= map {pdl $_} @ARGV;
say "Input:\n\t$I\n\t$J\nOutput: ",
($I-$J->dummy(0))->all' \
"[1,3,5,7,9]" "[0,2,4,6,8]"
Results:
Input:
[1 3 5 7 9]
[0 2 4 6 8]
Output: 1
The full version would be:
# Perl weekly challenge 127
# Task 1: disjoint sets
#
# See https://wlmb.github.io/2021/08/23/PWC127/#task-1-disjoint-sets
use warnings;
use strict;
use v5.12;
use PDL;
die 'Usage: ./ch-1.pl "[a1,a2,...]" "[b1,b2,...]" ... to test for disjointness'
unless @ARGV && @ARGV%2==0;
# Assume arguments of the form "[n1,n2,n3...]"
while(scalar @ARGV){
my ($s1, $s2)=map {pdl $_} splice @ARGV,0,2;
my $m=$s1-$s2->dummy(0);
my $disjoint=$m->all;
my $repeated=$s2->where($m->andover==0);
say "Input;\n\t$s1\n\t$s2\nOutput: $disjoint";
say $disjoint?"As there are no common members"
:"As the subset $repeated is common to both sets."
}
Example:
./ch-1.pl "[1,2,5,3,4]" "[4,6,7,8,9]" \
"[1,3,5,7,9]" "[0,2,4,6,8]"
Results:
Input;
[1 2 5 3 4]
[4 6 7 8 9]
Output: 0
As the subset [4] is common to both sets.
Input;
[1 3 5 7 9]
[0 2 4 6 8]
Output: 1
As there are no common members
Example with proper and improper subsets:
./ch-1.pl "[1,2,5,3,4]" "[5,2,1]" \
"[1,2,5,3,4]" "[4,3,5,2,1]"
Results:
Input;
[1 2 5 3 4]
[5 2 1]
Output: 0
As the subset [5 2 1] is common to both sets.
Input;
[1 2 5 3 4]
[4 3 5 2 1]
Output: 0
As the subset [4 3 5 2 1] is common to both sets.
Example with empty sets:
./ch-1.pl "[1,2,5,3,4]" "[]" \
"[]" "[1,2,5,3,4]" \
"[]" "[]"
Results:
Input;
[1 2 5 3 4]
Empty[0]
Output: 1
As there are no common members
Input;
Empty[0]
[1 2 5 3 4]
Output: 1
As there are no common members
Input;
Empty[0]
Empty[0]
Output: 1
As there are no common members
Task 2: Conflict Intervals
Submitted by: Mohammad S Anwar
You are given a list of intervals.
Write a script to find out if the current interval conflicts
with any of the previous intervals.
Example
Input: @Intervals = [ (1,4), (3,5), (6,8), (12, 13), (3,20) ]
Output: [ (3,5), (3,20) ]
- The 1st interval (1,4) do not have any previous
intervals to compare with, so skip it.
- The 2nd interval (3,5) does conflict with previous
interval (1,4).
- The 3rd interval (6,8) do not conflicts with any of the
previous intervals (1,4) and (3,5), so skip it.
- The 4th interval (12,13) again do not conflicts with any
of the previous intervals (1,4), (3,5) and (6,8), so
skip it.
- The 5th interval (3,20) conflicts with the first
interval (1,4).
Input: @Intervals = [ (3,4), (5,7), (6,9), (10, 12), (13,15) ]
Output: [ (6,9) ]
- The 1st interval (3,4) do not have any previous
intervals to compare with, so skip it.
- The 2nd interval (5,7) do not conflicts with the
previous interval (3,4), so skip it.
- The 3rd interval (6,9) does conflict with one of the
previous intervals (5,7).
- The 4th interval (10,12) do not conflicts with any of
the previous intervals (3,4), (5,7) and (6,9), so skip
it.
- The 5th interval (13,15) do not conflicts with any of
the previous intervals (3,4), (5,7), (6,9) and (10,12),
so skip it.
Although conflicting is not defined, from the examples it seems
to mean overlapping. Thus, an interval conflicts with a previous
one if its intersection is not empty. I assume the intervals
are open, so they don’t contain their end-points, and
non-empty. Then, two intervals (a,b) and (c,d) intersect iff c<b and a<d.
I can use the Perl Data Language PDL to solve the task. I
read all intervals as pairs of numbers from STDIN into a 2D
array with the first index denoting the left or right
boundary and the second index numbering the intervals. I use
dummy indices to test each interval against all other
intervals and build a matrix with 1’s for each pair ij
that overlaps and 0’s elsewhere. I select the upper
right triangular submatrix, corresponding to intervals that overlap previous
intervals. Finally, I get the indices of conflicting intervals
and use them to extract the actual conflicting intervals. This takes
only half a dozen lines of PDL code.
# Perl weekly challenge 127
# Task 2: Conflict intervals
#
# See https://wlmb.github.io/2021/08/23/PWC127/#task-2-conflict-intervals
use warnings;
use strict;
use v5.12;
use PDL;
use PDL::IO::Misc;
use PDL::NiceSlice;
# read all intervals into a 2D array
my $ints=(rcols *STDIN,[])->transpose;
# check constraint
die "Expected a<b for every interval (a,b)" if ($ints((0))>=$ints((1)))->any;
# build matrix: overlap(i,j)=1 iff i and j overlap
my $overlap=($ints((0),:,*1)<$ints((1),*1,:))&($ints((1),:,*1)>$ints((0),*1,:));
# Select intervals that overlap previous ones
my $overlap_previous=$overlap&($overlap->xvals>$overlap->yvals);
# Indices of conflicting intervals
my $conflicting_indices=$overlap_previous->transpose->orover->which;
# The actual conflicting intervals.
my $conf_ints=$ints->transpose->($conflicting_indices)->transpose;
# Print result
say "Input: $ints\nConflicting intervals: ",
$conf_ints->isempty?"None":"$conf_ints\nConflicts array: $overlap_previous";
Example 1:
./ch-2.pl << " END"
1 4
3 5
6 8
12 13
3 20
END
Results:
Input:
[
[ 1 4]
[ 3 5]
[ 6 8]
[12 13]
[ 3 20]
]
Conflicting intervals:
[
[ 3 5]
[ 3 20]
]
Conflicts array:
[
[0 1 0 0 1]
[0 0 0 0 1]
[0 0 0 0 1]
[0 0 0 0 1]
[0 0 0 0 0]
]
Note: In PDL the first index of a matrix runs from left to
right and the second from top to bottom. Thus the conflicts
array above shows that the second interval conflicts with the
first and fifth interval conflicts with all the previous
ones.
Example 2:
./ch-2.pl <<" END"
3 4
5 7
6 9
10 12
13 15
END
Results:
Input:
[
[ 3 4]
[ 5 7]
[ 6 9]
[10 12]
[13 15]
]
Conflicting intervals:
[
[6 9]
]
Conflicts array:
[
[0 0 0 0 0]
[0 0 1 0 0]
[0 0 0 0 0]
[0 0 0 0 0]
[0 0 0 0 0]
]
Example, conflict-free:
./ch-2.pl <<" END"
1 4
6 8
12 13
15 20
END
Results:
Input:
[
[ 1 4]
[ 6 8]
[12 13]
[15 20]
]
Conflicting intervals: None