diff options
| -rw-r--r-- | challenge-127/bruce-gray/perl/ch-1.pl | 28 | ||||
| -rw-r--r-- | challenge-127/bruce-gray/perl/ch-2.pl | 39 | ||||
| -rw-r--r-- | challenge-127/bruce-gray/perl/ch-2_even_more_haskell-ish.pl | 40 | ||||
| -rw-r--r-- | challenge-127/bruce-gray/raku/ch-1.raku | 14 | ||||
| -rw-r--r-- | challenge-127/bruce-gray/raku/ch-2.raku | 36 |
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; |