Merge pull request #4816 from Util/branch-for-challenge-127

Add Raku and Perl solutions for #127 by Bruce Gray

5 files changed, 157 insertions, 0 deletions

diff --git a/challenge-127/bruce-gray/perl/ch-1.pl b/challenge-127/bruce-gray/perl/ch-1.pl
new file mode 100644
index 0000000000..fd835af593
--- /dev/null
+++ b/challenge-127/bruce-gray/perl/ch-1.pl
@@ -0,0 +1,28 @@
+use strict;
+use warnings;
+use 5.026;
+use experimental qw<signatures>;
+use List::Util   qw<uniq>;
+use Test::More;
+
+# Without uniq or input checking: my %s; return 0 + !grep { ++$s{$_} >= 2 } map { @{$_} } @_;
+
+sub sets_are_disjoint ( $x_aref, $y_aref ) {
+    my @x = @{$x_aref};
+    my @y = @{$y_aref};
+    die "Input set X was not unique" if @x != uniq(@x);
+    die "Input set Y was not unique" if @y != uniq(@y);
+
+    return 0 + ( @x + @y == uniq(@x, @y) );
+}
+
+my @tests = (
+    [ 0 => [ [1, 2, 5, 3, 4], [4, 6, 7, 8, 9] ] ],
+    [ 1 => [ [1, 3, 5, 7, 9], [0, 2, 4, 6, 8] ] ],
+    [ 1 => [ [             ], [             ] ] ],
+);
+plan tests => 0+@tests;
+for (@tests) {
+    my ($expected, $input) = @{$_};
+    is sets_are_disjoint(@{$input}), $expected;
+}
\ No newline at end of file
diff --git a/challenge-127/bruce-gray/perl/ch-2.pl b/challenge-127/bruce-gray/perl/ch-2.pl
new file mode 100644
index 0000000000..2f915a0ad4
--- /dev/null
+++ b/challenge-127/bruce-gray/perl/ch-2.pl
@@ -0,0 +1,39 @@
+use strict;
+use warnings;
+use 5.026;
+use experimental qw<signatures>;
+use List::Util   qw<first>;
+use Test::More;
+
+sub happens_earlier ( $comparitor, $list_aref ) {
+    my @l = @{$list_aref};
+    my @r;
+    for my $i ( keys @l ) {
+        my $li = $l[$i];
+        push @r, $li if defined first { $comparitor->($li, $_) } @l[0 .. $i-1];
+    }
+    return @r;
+}
+
+# sub conflicts_with { $_[0][0] <= $_[1][1] && $_[1][0] <= $_[0][1] } # Equivalent to sub below, but just rude!
+sub conflicts_with ( $x, $y ) {
+    my ( $x_min, $x_max, $y_min, $y_max ) = ( @{$x}, @{$y} );
+    return !(     $x_min > $y_max
+               or $y_min > $x_max );
+}
+sub all_conflicts_earlier { happens_earlier( \&conflicts_with, @_ ) }
+
+
+sub format_for_challenge {
+    return '[ ' . join( ', ', map { '(' . join(',', @{$_}) . ')' } @_ ) . ' ]';
+}
+my @tests = (
+    [ [ [1,4], [3,5], [6,8], [12, 13], [ 3,20] ] => "[ (3,5), (3,20) ]" ],
+    [ [ [3,4], [5,7], [6,9], [10, 12], [13,15] ] => "[ (6,9) ]" ],
+    [ [ [3,4], [5,7], [8,8], [10, 12], [13,15] ] => "[  ]" ],
+);
+plan tests => 0+@tests;
+for (@tests) {
+    my ($input, $expected) = @{$_};
+    is format_for_challenge(all_conflicts_earlier($input)), $expected;
+}
diff --git a/challenge-127/bruce-gray/perl/ch-2_even_more_haskell-ish.pl b/challenge-127/bruce-gray/perl/ch-2_even_more_haskell-ish.pl
new file mode 100644
index 0000000000..5b2ad877e4
--- /dev/null
+++ b/challenge-127/bruce-gray/perl/ch-2_even_more_haskell-ish.pl
@@ -0,0 +1,40 @@
+use strict;
+use warnings;
+use 5.026;
+use experimental qw<signatures>;
+use List::Util   qw<first>;
+use Test::More;
+
+sub happens_earlier ( $comparitor ) {
+    return sub ( $list_aref ) {
+        my @l = @{$list_aref};
+        my @r;
+        for my $i ( keys @l ) {
+            my $li = $l[$i];
+            push @r, $li if defined first { $comparitor->($li, $_) } @l[0 .. $i-1];
+        }
+        return @r;
+    }
+}
+
+sub conflicts_with ( $x, $y ) {
+    my ( $x_min, $x_max, $y_min, $y_max ) = ( @{$x}, @{$y} );
+    return !(     $x_min > $y_max
+               or $y_min > $x_max );
+}
+sub all_conflicts_earlier { happens_earlier( \&conflicts_with )->(@_) }
+
+
+sub format_for_challenge {
+    return '[ ' . join( ', ', map { '(' . join(',', @{$_}) . ')' } @_ ) . ' ]';
+}
+my @tests = (
+    [ [ [1,4], [3,5], [6,8], [12, 13], [ 3,20] ] => "[ (3,5), (3,20) ]" ],
+    [ [ [3,4], [5,7], [6,9], [10, 12], [13,15] ] => "[ (6,9) ]" ],
+    [ [ [3,4], [5,7], [8,8], [10, 12], [13,15] ] => "[  ]" ],
+);
+plan tests => 0+@tests;
+for (@tests) {
+    my ($input, $expected) = @{$_};
+    is format_for_challenge(all_conflicts_earlier($input)), $expected;
+}
diff --git a/challenge-127/bruce-gray/raku/ch-1.raku b/challenge-127/bruce-gray/raku/ch-1.raku
new file mode 100644
index 0000000000..0207f4ae21
--- /dev/null
+++ b/challenge-127/bruce-gray/raku/ch-1.raku
@@ -0,0 +1,14 @@
+use Test;
+
+sub sets_are_disjoint { + not @^S1 ∩ @^S2 }
+
+my @tests =
+    ( 0 => ( (1, 2, 5, 3, 4), (4, 6, 7, 8, 9) ) ),
+    ( 1 => ( (1, 3, 5, 7, 9), (0, 2, 4, 6, 8) ) ),
+    ( 1 => ( (             ), (             ) ) ),
+;
+plan +@tests;
+for @tests {
+    my ($expected, $input) = .kv;
+    is sets_are_disjoint(|$input), $expected;
+}
diff --git a/challenge-127/bruce-gray/raku/ch-2.raku b/challenge-127/bruce-gray/raku/ch-2.raku
new file mode 100644
index 0000000000..dba22ff789
--- /dev/null
+++ b/challenge-127/bruce-gray/raku/ch-2.raku
@@ -0,0 +1,36 @@
+# ䷅ U+4DC5 https://unicode-table.com/en/4DC5/ Hexagram for "Conflict"
+# ䷿ U+4DFF https://unicode-table.com/en/4DFF/ Hexagram for "Before Completion"
+
+multi sub infix:<䷅> ( Range $a, Range $b --> Bool ) {
+    ?(    $a.min|$a.max ~~ $b
+       or $b.min|$b.max ~~ $a )
+}
+multi sub prefix:<䷿> ( &op, @a --> Seq ) {
+    return @a.kv.map: -> Int $k, $v {
+        $v if op( $v, @a.head($k).any );
+    }
+}
+my &prefix:<䷅䷿> = &prefix:<䷿>.assuming(&infix:<䷅>);
+
+my @tests =
+    ( (1,4), (3,5), (6,8), (12, 13), ( 3,20) ),
+    ( (3,4), (5,7), (6,9), (10, 12), (13,15) ),
+    ( (3,4), (5,7), (8,8), (10, 12), (13,15) ),
+;
+
+$_ .= map({ Range.new(|$_) }) for @tests;
+
+say ䷅䷿ $_ for @tests;
+
+# Working, but not used:
+# Single pass, so linear in the length of the input array, 
+# *but* horrific performance if any interval is very wide.
+# sub conflicts_with_any_earlier ( @intervals ) {
+#     my Set $acc;
+#     return gather for @intervals {
+#         my Set $i = set .[0] .. .[1];
+#         .take if $i ∩ $acc;
+#         $acc ∪= $i;
+#     }
+# }
+# say .&conflicts_with_any_earlier for @tests;