week 127

2 files changed, 142 insertions, 0 deletions

diff --git a/challenge-127/cheok-yin-fung/perl/ch-1.pl b/challenge-127/cheok-yin-fung/perl/ch-1.pl
new file mode 100644
index 0000000000..8a663a6a81
--- /dev/null
+++ b/challenge-127/cheok-yin-fung/perl/ch-1.pl
@@ -0,0 +1,49 @@
+#!/usr/bin/perl
+# The Weekly Challenge 127
+# Task 1 Disjoint Sets
+# Usage: $ ch-1.pl 
+use v5.12.0;
+no warnings;
+use experimental qw/signatures/;
+use Test::More tests => 5;
+
+sub disjoint ($s1 , $s2) {
+    my @S1 = sort $s1->@*;
+    my @S2 = sort $s2->@*;
+
+    my (@Ss, @Sl);
+
+    if (scalar @S1 > scalar @S2) {
+        @Ss = @S2;
+        @Sl = @S1;
+    }
+    else {
+        @Ss = @S1;
+        @Sl = @S2;
+    }
+
+    my $ref_ind = 0;
+    for (0..$#Ss) {
+        while ($Sl[$ref_ind] < $Ss[$_]) {
+            last if $ref_ind == $#Sl;
+            $ref_ind++;
+        }
+        return 0 if $Sl[$ref_ind] == $Ss[$_];
+    }
+
+    return 1;
+}
+
+ok disjoint( [1, 2, 5, 3, 4], [4, 6, 7, 8, 9] ) == 0, 
+    "Example 1";
+ok disjoint( [1, 3, 5, 7, 9], [0, 2, 4, 6, 8] ) == 1, 
+    "Example 2";
+
+ok disjoint( [1, 3, 5, 7], [0, 2, 4, 6, 7] ) == 0,
+    "Test case 1";
+
+ok disjoint( [7], [0, 2, 4, 6, 7] ) == 0,
+    "Test case 2";
+
+ok disjoint( [2], [0, 2, 4, 6, 7] ) == 0,
+    "Test case 3";
diff --git a/challenge-127/cheok-yin-fung/perl/ch-2.pl b/challenge-127/cheok-yin-fung/perl/ch-2.pl
new file mode 100644
index 0000000000..3a4a49c7f3
--- /dev/null
+++ b/challenge-127/cheok-yin-fung/perl/ch-2.pl
@@ -0,0 +1,93 @@
+#!/usr/bin/perl
+# The Weekly Challenge 127
+# Task 2 Conflict Intervals
+# Usage: $ ch-2.pl 1 4 3 5 6 8 
+# for checking intervals (1, 4), (3, 5), (6, 8)  
+use warnings;
+use v5.12.0;
+use List::Util qw/max min/; 
+use Test::More tests => 2;
+use Test::Deep;
+
+my @inp;
+
+@inp = ([1,3], [3,4], [7,9]) if !defined($ARGV[0]);
+if ((scalar @ARGV) % 2 == 1) {
+    die "Even number of terms should be entered.\n";
+}
+
+for (my $i = 0; $i <= $#ARGV ;$i+=2) {
+    die "Invalid interval: ($ARGV[$i], $ARGV[$i+1])\n" if $ARGV[$i] >= $ARGV[$i+1];
+    push @inp, [$ARGV[$i], $ARGV[$i+1]];
+}
+
+my $answer = conflict_intervals(@inp);
+
+if (scalar $answer->@* > 0) {
+    say "($_->[0], $_->[1])" for $answer->@*;
+}
+else {
+    say "No conflicts found."
+}
+
+sub conflict_intervals {
+    my @intervals = @_;
+    my @pre_intervals;
+    my @new_intervals;
+    my @ans;
+    push @new_intervals, $intervals[0];
+
+    for my $i (1..$#intervals) {
+        my $bool_cf = undef;
+        @pre_intervals = @new_intervals;
+        @new_intervals = ();
+        for my $interv (@pre_intervals) {
+            if (conf( $intervals[$i], $interv)) {
+                push @new_intervals, merge($intervals[$i], $interv);
+                $bool_cf = 1;
+            }
+            else {
+                push @new_intervals, $interv;
+            }
+        }
+        push @new_intervals, $intervals[$i] if !$bool_cf;
+        push @ans, $intervals[$i] if $bool_cf;
+    }
+    return [@ans];
+}
+
+sub merge {
+    return [ 
+      min($_[0]->[0], $_[1]->[0]), 
+      max($_[0]->[1], $_[1]->[1])
+    ];
+}
+
+sub conf {
+    my $i1;
+    my $i2;
+    if ($_[0]->[0] < $_[1]->[0]) {
+        $i1 = $_[0];
+        $i2 = $_[1];
+    }
+    elsif ($_[0]->[0] > $_[1]->[0]) {
+        $i1 = $_[1];
+        $i2 = $_[0];
+    }
+    else {
+        return 1;
+    }
+    return 1 if $i1->[1] > $i2->[0];
+    return 0;
+}
+
+cmp_deeply( 
+    conflict_intervals([1,4], [3,5], [6,8], [12, 13], [3, 20]), 
+    [[3,5],[3,20]] , 
+    "Example 1" 
+);
+cmp_deeply( 
+    conflict_intervals([3,4], [5,7], [6,9], [10,12], [13, 15]),
+    [[6,9]],
+    "Example 2"
+);