From e2ad1e1161f33392378b36684bf2d0adf6a37b8b Mon Sep 17 00:00:00 2001
From: Util <bruce.gray@acm.org>
Date: Sat, 31 Jul 2021 14:54:21 -0500
Subject: Add Raku and Perl solutions for #123 by Bruce Gray.

---
 challenge-123/bruce-gray/perl/ch-1.pl   | 30 +++++++++++++++++++++++++++
 challenge-123/bruce-gray/perl/ch-2.pl   | 36 +++++++++++++++++++++++++++++++++
 challenge-123/bruce-gray/raku/ch-1.raku | 17 ++++++++++++++++
 challenge-123/bruce-gray/raku/ch-2.raku | 30 +++++++++++++++++++++++++++
 4 files changed, 113 insertions(+)
 create mode 100644 challenge-123/bruce-gray/perl/ch-1.pl
 create mode 100644 challenge-123/bruce-gray/perl/ch-2.pl
 create mode 100644 challenge-123/bruce-gray/raku/ch-1.raku
 create mode 100644 challenge-123/bruce-gray/raku/ch-2.raku

diff --git a/challenge-123/bruce-gray/perl/ch-1.pl b/challenge-123/bruce-gray/perl/ch-1.pl
new file mode 100644
index 0000000000..b0887676cd
--- /dev/null
+++ b/challenge-123/bruce-gray/perl/ch-1.pl
@@ -0,0 +1,30 @@
+use strict;
+use warnings;
+use 5.010;
+use List::Util qw<uniq first>;
+use Test::More;
+
+sub is_square {
+    die if @_ != 4;
+
+    my %xy;
+    push @{ $xy{ 'x'.$_->[0] } }, $_ for @_;
+    push @{ $xy{ 'y'.$_->[1] } }, $_ for @_;
+
+    my @unique_points    = uniq map { join ',', @{$_} } @_;
+    my @unaligned_points = grep { @{$_} != 2 } values %xy;
+
+    return 0 + (     @unique_points    == 4
+                 and @unaligned_points == 0 );
+}
+
+my @tests = (
+    [ SampleA   => 1, [10,20],[20,20],[20,10],[10,10] ],
+    [ SampleB   => 0, [12,24],[16,10],[20,12],[18,16] ],
+    [ NotUnique => 0, [10,20],[20,10],[10,20],[20,10] ],
+);
+plan tests => 0+@tests;
+for my $t (@tests) {
+    my ( $name, $expected, @input ) = @{$t};
+    is is_square(@input), $expected, $name;
+}
diff --git a/challenge-123/bruce-gray/perl/ch-2.pl b/challenge-123/bruce-gray/perl/ch-2.pl
new file mode 100644
index 0000000000..0519bc0103
--- /dev/null
+++ b/challenge-123/bruce-gray/perl/ch-2.pl
@@ -0,0 +1,36 @@
+use strict;
+use warnings;
+use 5.020;
+use experimental qw<signatures>;
+use List::Util   qw<min>;
+use Test::More;
+
+sub ugly_ith ( $nth ) {
+    state $Hammings = [];
+
+    state $cin = [ map { { C => $_, N => 1, I => 0 } } 2, 3, 5 ];
+    while ( @{$Hammings} < $nth ) {
+        my $taken = min map { $_->{N} } @{$cin};
+        push @{$Hammings}, $taken;
+
+        for (@{$cin}) {
+            if ($_->{N} == $taken) {
+                $_->{N} = $_->{C} * $Hammings->[ $_->{I} ];
+                $_->{I}++;
+            }
+        }
+    }
+
+    return $Hammings->[$nth - 1];
+}
+
+use Test::More;
+my @tests = ( # https://oeis.org/A051037
+    1, 2, 3, 4, 5, 6, 8, 9, 10, 12, 15, 16, 18, 20, 24, 25, 27, 30, 32, 36, 40, 45, 48, 50, 54, 60, 64, 72, 75, 80, 81, 90, 96, 100, 108, 120, 125, 128, 135, 144, 150, 160, 162, 180, 192, 200, 216, 225, 240, 243, 250, 256, 270, 288, 300, 320, 324, 360, 375, 384, 400, 405
+);
+plan tests => 0+@tests;
+for my $i ( keys @tests ) {
+    my $expected = $tests[$i];
+    my $ordinal  = $i + 1;
+    is ugly_ith($ordinal), $expected, "ugly-ith($ordinal) == $expected";
+}
diff --git a/challenge-123/bruce-gray/raku/ch-1.raku b/challenge-123/bruce-gray/raku/ch-1.raku
new file mode 100644
index 0000000000..bd32953b4e
--- /dev/null
+++ b/challenge-123/bruce-gray/raku/ch-1.raku
@@ -0,0 +1,17 @@
+sub is-square ( @p where *.elems == 4 ) {
+    my %xy = @p.categorize( <x y> Z~ *.list );
+
+    return @p.map(*.Str).unique == 4
+        && so %xy.values.all    == 2;
+}
+
+my @tests =
+    ( 'SampleA'   , True  , ((10,20),(20,20),(20,10),(10,10)) ),
+    ( 'SampleB'   , False , ((12,24),(16,10),(20,12),(18,16)) ),
+    ( 'NotUnique' , False , ((10,20),(20,10),(10,20),(20,10)) ),
+;
+use Test;
+plan +@tests;
+for @tests -> ( $name, $expected, @input ) {
+    is is-square(@input), $expected, $name;
+}
diff --git a/challenge-123/bruce-gray/raku/ch-2.raku b/challenge-123/bruce-gray/raku/ch-2.raku
new file mode 100644
index 0000000000..3bd1b324b3
--- /dev/null
+++ b/challenge-123/bruce-gray/raku/ch-2.raku
@@ -0,0 +1,30 @@
+sub ugly-ith ( UInt:D $n'th where * != 0 ) {
+    state $Hammings = gather {
+        class Ham {
+            has Int      $.C;
+            has Int      $.N = 1;
+            has Iterator $!I = $Hammings.iterator;
+            method bump ( ) {
+                $!N = $.C * $!I.pull-one;
+            }
+        }
+
+        my @cin = map { Ham.new: :C($_) }, 2, 3, 5;
+
+        loop {
+            take my $taken = @cin».N.min;
+            .bump if .N == $taken for @cin;
+        }
+    }
+    return $Hammings[$n'th - 1];
+}
+
+use Test;
+my @tests = ( # https://oeis.org/A051037
+    1, 2, 3, 4, 5, 6, 8, 9, 10, 12, 15, 16, 18, 20, 24, 25, 27, 30, 32, 36, 40, 45, 48, 50, 54, 60, 64, 72, 75, 80, 81, 90, 96, 100, 108, 120, 125, 128, 135, 144, 150, 160, 162, 180, 192, 200, 216, 225, 240, 243, 250, 256, 270, 288, 300, 320, 324, 360, 375, 384, 400, 405
+);
+plan +@tests;
+for @tests.kv -> $i, $expected {
+    my $ordinal = $i + 1;
+    is ugly-ith($ordinal), $expected, "ugly-ith($ordinal) == $expected";
+}
-- 
cgit