Merge branch 'master' of https://github.com/manwar/perlweeklychallenge-club

6 files changed, 117 insertions, 0 deletions

diff --git a/challenge-127/polettix/blog.txt b/challenge-127/polettix/blog.txt
new file mode 100644
index 0000000000..01af53de0b
--- /dev/null
+++ b/challenge-127/polettix/blog.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2021/08/25/pwc127-disjoint-sets/
diff --git a/challenge-127/polettix/blog1.txt b/challenge-127/polettix/blog1.txt
new file mode 100644
index 0000000000..f667506e7f
--- /dev/null
+++ b/challenge-127/polettix/blog1.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2021/08/26/pwc127-conflict-intervals/
diff --git a/challenge-127/polettix/perl/ch-1.pl b/challenge-127/polettix/perl/ch-1.pl
new file mode 100644
index 0000000000..c8595a4db8
--- /dev/null
+++ b/challenge-127/polettix/perl/ch-1.pl
@@ -0,0 +1,13 @@
+#!/usr/bin/env perl
+use v5.24;
+use warnings;
+use experimental 'signatures';
+no warnings 'experimental::signatures';
+
+sub disjoint_sets ($seq1, $seq2) {
+   my %flag = map { $_ => 1 } $seq1->@*;
+   for my $e ($seq2->@*) { return 0 if exists $flag{$e} }
+   return 1;
+}
+
+say disjoint_sets(map { [split m{\D+}mxs] } @ARGV);
diff --git a/challenge-127/polettix/perl/ch-2.pl b/challenge-127/polettix/perl/ch-2.pl
new file mode 100644
index 0000000000..e0f59c1a83
--- /dev/null
+++ b/challenge-127/polettix/perl/ch-2.pl
@@ -0,0 +1,48 @@
+#!/usr/bin/env perl
+use v5.24;
+use warnings;
+use experimental 'signatures';
+no warnings 'experimental::signatures';
+
+sub conflict_intervals (@intervals) {
+   my @conflicting; # keep the answer
+   while (@intervals) {
+
+      # if there is a "first" one, it's safe because it has not been
+      # eliminated by its predecessors. Its endpoints will be used to
+      # possibly eliminate successors, we keep them in two convenience
+      # variables.
+      my ($X, $Y) = shift(@intervals)->@*;
+
+      # we filter the remaining intervals ditching all those that
+      # conflict with ($X, $Y) or whatever it becomes on the way. In
+      # particular, at every conflict we expand ($X, $Y) to also
+      # include the conflicting item, because we will ditch it from
+      # the candidate "clean" intervals and put it in @conflicting.
+      @intervals = grep {
+         my ($A, $B) = $_->@*;
+
+         # this is a general check to see if the two intervals are
+         # disjoint. It assumes that touching intervals are conflicting.
+         ($A - $Y) * ($B - $X) > 0 or do {
+            push @conflicting, $_;
+            $X = $A if $X > $A;  # "eat" the ($A, $B) interval in ($X, $Y)
+            $Y = $B if $Y < $B;
+            0; # this interval conflicted and does not get passed along
+         }
+      } @intervals;
+   }
+   return @conflicting;
+}
+
+sub print_intervals (@intervals) {
+   print {*STDOUT} '[ ';
+   print {*STDOUT} join ', ', map { ; "($_->[0],$_->[1])" } @intervals;
+   print {*STDOUT} ' ' if @intervals;
+   say {*STDOUT} ']';
+} ## end sub print_intervals (@intervals)
+
+my @intervals =
+  @ARGV ? @ARGV : ([1, 4], [3, 5], [6, 8], [12, 13], [3, 20]);
+$_ = ref($_) ? $_ : [m{(\d+)}gmxs] for @intervals;
+print_intervals(conflict_intervals(@intervals));
diff --git a/challenge-127/polettix/raku/ch-1.raku b/challenge-127/polettix/raku/ch-1.raku
new file mode 100644
index 0000000000..8572485f51
--- /dev/null
+++ b/challenge-127/polettix/raku/ch-1.raku
@@ -0,0 +1,6 @@
+#!/usr/bin/env raku
+use v6;
+sub MAIN (*@args) {
+   my @sequences = @args.map: *.split(/\D+/).Set;
+   put ([(&)] @sequences) ?? 0 !! 1;
+}
diff --git a/challenge-127/polettix/raku/ch-2.raku b/challenge-127/polettix/raku/ch-2.raku
new file mode 100644
index 0000000000..12cb69ce8f
--- /dev/null
+++ b/challenge-127/polettix/raku/ch-2.raku
@@ -0,0 +1,48 @@
+#!/usr/bin/env raku
+use v6;
+sub MAIN (*@args) {
+   my @intervals = @args ?? @args !!
+      ((1, 4), (3, 5), (6, 8), (12, 13), (3, 20));
+   for @intervals -> $interval is rw {
+      $interval = $interval.comb(/\d+/).Array if $interval ~~ Str;
+   }
+   print-intervals(conflict-intervals(@intervals));
+}
+
+sub print-intervals (@intervals) {
+   print '[ ';
+   @intervals.map({"({$_[0]},{$_[1]})"}).join(', ').print;
+   print ' ' if @intervals;
+   put ']';
+} ## end sub print_intervals (@intervals)
+
+sub conflict-intervals (@intervals) {
+   return gather {
+      while @intervals {
+
+         # if there is a "first" one, it's safe because it has not been
+         # eliminated by its predecessors. Its endpoints will be used to
+         # possibly eliminate successors, we keep them in two convenience
+         # variables.
+         my ($X, $Y) = @intervals.shift.Slip;
+
+         # we filter the remaining intervals ditching all those that
+         # conflict with ($X, $Y) or whatever it becomes on the way. In
+         # particular, at every conflict we expand ($X, $Y) to also
+         # include the conflicting item, because we will ditch it from
+         # the candidate "clean" intervals and put it in @conflicting.
+         @intervals = @intervals.grep: -> $interval {
+            my ($A, $B) = |$interval;
+
+            # this is a general check to see if the two intervals are
+            # disjoint. It assumes that touching intervals are conflicting.
+            ($A - $Y) * ($B - $X) > 0 or do {
+               take $interval;
+               $X = $A if $X > $A;  # "eat" ($A, $B) in ($X, $Y)
+               $Y = $B if $Y < $B;
+               0; # this interval conflicted and does not get passed along
+            }
+         }
+      }
+   }
+}