Merge pull request #8217 from Util/c220

Add TWC 220 blog post and solutions by Bruce Gray (Raku and Perl).

5 files changed, 228 insertions, 0 deletions

diff --git a/challenge-220/bruce-gray/blog.txt b/challenge-220/bruce-gray/blog.txt
new file mode 100644
index 0000000000..58db7439bf
--- /dev/null
+++ b/challenge-220/bruce-gray/blog.txt
@@ -0,0 +1 @@
+https://blogs.perl.org/users/bruce_gray/2023/06/twc-220-squared-shoulders.html
diff --git a/challenge-220/bruce-gray/perl/ch-1.pl b/challenge-220/bruce-gray/perl/ch-1.pl
new file mode 100644
index 0000000000..d4d64fa250
--- /dev/null
+++ b/challenge-220/bruce-gray/perl/ch-1.pl
@@ -0,0 +1,20 @@
+use v5.36;
+use List::Util qw<uniq>;
+sub task1 ( @words ) {
+    my %h;
+    $h{$_}++ for map { uniq split '', lc $_ } @words;
+
+    return [ grep { $h{$_} == @words } sort keys %h ];
+}
+
+
+my @tests = (
+    [ [qw<Perl Rust Raku> ] ,  [qw<r>]     ],
+    [ [qw<love live leave>] ,  [qw<e l v>] ],
+);
+use Test::More;
+plan tests => 0+@tests;
+for (@tests) {
+    my ( $in_aref, $expected_aref ) = @{$_};
+    is_deeply task1(@{$in_aref}), $expected_aref;
+}
diff --git a/challenge-220/bruce-gray/perl/ch-2.pl b/challenge-220/bruce-gray/perl/ch-2.pl
new file mode 100644
index 0000000000..92f066bdba
--- /dev/null
+++ b/challenge-220/bruce-gray/perl/ch-2.pl
@@ -0,0 +1,103 @@
+use v5.36;
+sub is_perfect_square ( $n ) {
+    return $n == ( int(sqrt $n) ** 2 );
+}
+
+sub task2 ( @ns ) {
+
+    my %square_pairs;
+    for     my $x (@ns) {
+        for my $y (@ns) {
+            if ( is_perfect_square( $x + $y ) ) {
+                $square_pairs{$x}{$y} = $y;
+                $square_pairs{$y}{$x} = $x;
+            }
+        }
+    }
+
+    my ( $bag_add, $bag_del, $bag_keys, $bag_empty );
+    {
+        my %n_count;
+        $bag_add   = sub ( $n ) { $n_count{$n}++; };
+        $bag_del   = sub ( $n ) { $n_count{$n}--;  delete $n_count{$n} if not $n_count{$n}; };
+        $bag_keys  = sub ()     { sort { $a <=> $b } keys %n_count };
+        $bag_empty = sub ()     {                     not %n_count };
+    }
+
+    $bag_add->($_) for @ns;
+
+    my $recursing = sub ( $head ) {
+        return [$head] if $bag_empty->();
+
+        my @ret;
+        for my $c ( grep {defined} @{$square_pairs{$head}}{ $bag_keys->() } ) {
+            $bag_del->($c);
+            push @ret, map { [$head, @{$_} ] } __SUB__->( $c );
+            $bag_add->($c);
+        }
+        return @ret;
+    };
+
+    my @ret;
+    for my $head ( $bag_keys->() ) {
+        $bag_del->($head);
+        push @ret, $recursing->( $head );
+        $bag_add->($head);
+    }
+
+    return \@ret;
+}
+
+
+my @tests = (
+    [ [1, 17, 8] , [ [1, 8, 17], [17, 8, 1] ] ],
+    [ [2,  2, 2] , [ [2, 2,  2],            ] ],
+
+    [ [ 1..14 ] , [  ] ],
+    [ [ 1..15 ] , [ [8, 1, 15, 10, 6, 3, 13, 12, 4, 5, 11, 14, 2, 7, 9],
+                        [9, 7, 2, 14, 11, 5, 4, 12, 13, 3, 6, 10, 15, 1, 8] ] ],
+    [ [ 1..16 ] , [ [8, 1, 15, 10, 6, 3, 13, 12, 4, 5, 11, 14, 2, 7, 9, 16],
+                        [16, 9, 7, 2, 14, 11, 5, 4, 12, 13, 3, 6, 10, 15, 1, 8] ] ],
+    [ [ 1..17 ] , [ [16, 9, 7, 2, 14, 11, 5, 4, 12, 13, 3, 6, 10, 15, 1, 8, 17],
+                        [17, 8, 1, 15, 10, 6, 3, 13, 12, 4, 5, 11, 14, 2, 7, 9, 16] ] ],
+    [ [ 1..18 ] , [  ] ],
+    [ [ 1..19 ] , [  ] ],
+    [ [ 1..20 ] , [  ] ],
+    [ [ 1..21 ] , [  ] ],
+    [ [ 1..22 ] , [  ] ],
+    [ [ 1..23 ] , [
+        [2, 23, 13, 12, 4, 21, 15, 10, 6, 19, 17, 8, 1, 3, 22, 14, 11, 5, 20, 16, 9, 7, 18],
+        [9, 16, 20, 5, 11, 14, 22, 3, 1, 8, 17, 19, 6, 10, 15, 21, 4, 12, 13, 23, 2, 7, 18],
+        [18, 7, 2, 23, 13, 12, 4, 21, 15, 10, 6, 19, 17, 8, 1, 3, 22, 14, 11, 5, 20, 16, 9],
+        [18, 7, 9, 16, 20, 5, 11, 14, 2, 23, 13, 12, 4, 21, 15, 10, 6, 19, 17, 8, 1, 3, 22],
+        [18, 7, 9, 16, 20, 5, 11, 14, 22, 3, 1, 8, 17, 19, 6, 10, 15, 21, 4, 12, 13, 23, 2],
+        [22, 3, 1, 8, 17, 19, 6, 10, 15, 21, 4, 12, 13, 23, 2, 14, 11, 5, 20, 16, 9, 7, 18], ] ],
+    [ [ 1..24 ] , [  ] ],
+    [ [ 1..25 ] , [
+        [2, 23, 13, 12, 24, 25, 11, 14, 22, 3, 1, 8, 17, 19, 6, 10, 15, 21, 4, 5, 20, 16, 9, 7, 18],
+        [3, 22, 14, 2, 23, 13, 12, 4, 21, 15, 10, 6, 19, 17, 8, 1, 24, 25, 11, 5, 20, 16, 9, 7, 18],
+        [4, 21, 15, 10, 6, 19, 17, 8, 1, 3, 22, 14, 2, 23, 13, 12, 24, 25, 11, 5, 20, 16, 9, 7, 18],
+        [8, 17, 19, 6, 10, 15, 21, 4, 12, 13, 23, 2, 14, 22, 3, 1, 24, 25, 11, 5, 20, 16, 9, 7, 18],
+        [9, 16, 20, 5, 4, 21, 15, 10, 6, 19, 17, 8, 1, 3, 22, 14, 11, 25, 24, 12, 13, 23, 2, 7, 18],
+        [10, 15, 21, 4, 12, 13, 23, 2, 14, 22, 3, 6, 19, 17, 8, 1, 24, 25, 11, 5, 20, 16, 9, 7, 18],
+        [11, 25, 24, 12, 13, 23, 2, 14, 22, 3, 1, 8, 17, 19, 6, 10, 15, 21, 4, 5, 20, 16, 9, 7, 18],
+        [13, 23, 2, 14, 22, 3, 1, 8, 17, 19, 6, 10, 15, 21, 4, 12, 24, 25, 11, 5, 20, 16, 9, 7, 18],
+        [18, 7, 2, 23, 13, 12, 24, 25, 11, 14, 22, 3, 1, 8, 17, 19, 6, 10, 15, 21, 4, 5, 20, 16, 9],
+        [18, 7, 9, 16, 20, 5, 4, 21, 15, 10, 6, 19, 17, 8, 1, 3, 22, 14, 2, 23, 13, 12, 24, 25, 11],
+        [18, 7, 9, 16, 20, 5, 4, 21, 15, 10, 6, 19, 17, 8, 1, 3, 22, 14, 11, 25, 24, 12, 13, 23, 2],
+        [18, 7, 9, 16, 20, 5, 11, 25, 24, 1, 3, 22, 14, 2, 23, 13, 12, 4, 21, 15, 10, 6, 19, 17, 8],
+        [18, 7, 9, 16, 20, 5, 11, 25, 24, 1, 8, 17, 19, 6, 3, 22, 14, 2, 23, 13, 12, 4, 21, 15, 10],
+        [18, 7, 9, 16, 20, 5, 11, 25, 24, 1, 8, 17, 19, 6, 10, 15, 21, 4, 12, 13, 3, 22, 14, 2, 23],
+        [18, 7, 9, 16, 20, 5, 11, 25, 24, 1, 8, 17, 19, 6, 10, 15, 21, 4, 12, 13, 23, 2, 14, 22, 3],
+        [18, 7, 9, 16, 20, 5, 11, 25, 24, 12, 4, 21, 15, 10, 6, 19, 17, 8, 1, 3, 13, 23, 2, 14, 22],
+        [18, 7, 9, 16, 20, 5, 11, 25, 24, 12, 4, 21, 15, 10, 6, 19, 17, 8, 1, 3, 22, 14, 2, 23, 13],
+        [18, 7, 9, 16, 20, 5, 11, 25, 24, 12, 13, 23, 2, 14, 22, 3, 1, 8, 17, 19, 6, 10, 15, 21, 4],
+        [22, 14, 2, 23, 13, 3, 1, 8, 17, 19, 6, 10, 15, 21, 4, 12, 24, 25, 11, 5, 20, 16, 9, 7, 18],
+        [23, 2, 14, 22, 3, 13, 12, 4, 21, 15, 10, 6, 19, 17, 8, 1, 24, 25, 11, 5, 20, 16, 9, 7, 18], ] ],
+);
+use Test::More;
+plan tests => 0+@tests;
+for (@tests) {
+    my ( $in_aref, $expected_aref ) = @{$_};
+    is_deeply task2(@{$in_aref}), $expected_aref;
+}
diff --git a/challenge-220/bruce-gray/raku/ch-1.raku b/challenge-220/bruce-gray/raku/ch-1.raku
new file mode 100644
index 0000000000..c579e65b45
--- /dev/null
+++ b/challenge-220/bruce-gray/raku/ch-1.raku
@@ -0,0 +1,14 @@
+sub task1 ( @words --> Seq ) {
+    return sort keys [∩] map *.lc.comb.Set, @words;
+}
+
+
+my @tests =
+    ( <Perl Rust Raku>  ,  (<r>,)  ),
+    ( <love live leave> ,  <e l v> ),
+;
+use Test;
+plan +@tests;
+for @tests -> ( @in, @expected ) {
+    is-deeply task1(@in), @expected;
+}
diff --git a/challenge-220/bruce-gray/raku/ch-2.raku b/challenge-220/bruce-gray/raku/ch-2.raku
new file mode 100644
index 0000000000..2d96177176
--- /dev/null
+++ b/challenge-220/bruce-gray/raku/ch-2.raku
@@ -0,0 +1,90 @@
+sub is-perfect-square ( UInt $n --> Bool ) {
+    return $n.sqrt.round.² == $n;
+}
+
+sub task2_slow ( @ns --> Seq ) {
+    sub all-pairs-sum-to-perfect-squares ( @p --> Bool ) {
+        return @p.rotor(2 => -1).map( *.sum.&is-perfect-square ).all.so;
+    }
+    return @ns.permutations.grep(&all-pairs-sum-to-perfect-squares).sort.squish(:with(&[eqv]));
+}
+
+sub task2 ( @ns --> Seq ) {
+    my %square_pairs = @ns.map: -> $a {
+        $a => @ns.grep( -> $b { is-perfect-square( $a + $b ) } ).Set;
+    }
+
+    my BagHash $n_count = @ns.BagHash;
+
+    sub recursing ( UInt $head ) {
+        return $head if not $n_count;
+
+        return gather for %square_pairs{$head}{ $n_count.keys }:k -> UInt $c {
+            $n_count{$c}--;
+            .take for recursing( $c ).map({ $head, |$_ });
+            $n_count{$c}++;
+        }
+    }
+
+    return sort gather for $n_count.keys -> $head {
+        $n_count{$head}--;
+        .take for recursing( $head );
+        $n_count{$head}++;
+    }
+}
+
+
+my @tests =
+    ( (1, 17, 8) , ( (1, 8, 17), (17, 8, 1) ) ),
+    ( (2,  2, 2) , ( (2, 2,  2),            ) ),
+
+    ( ((1..14).list) , (  ) ),
+    ( ((1..15).list) , ( (8, 1, 15, 10, 6, 3, 13, 12, 4, 5, 11, 14, 2, 7, 9),
+                         (9, 7, 2, 14, 11, 5, 4, 12, 13, 3, 6, 10, 15, 1, 8) ) ),
+    ( ((1..16).list) , ( (8, 1, 15, 10, 6, 3, 13, 12, 4, 5, 11, 14, 2, 7, 9, 16),
+                         (16, 9, 7, 2, 14, 11, 5, 4, 12, 13, 3, 6, 10, 15, 1, 8) ) ),
+    ( ((1..17).list) , ( (16, 9, 7, 2, 14, 11, 5, 4, 12, 13, 3, 6, 10, 15, 1, 8, 17),
+                         (17, 8, 1, 15, 10, 6, 3, 13, 12, 4, 5, 11, 14, 2, 7, 9, 16) ) ),
+    ( ((1..18).list) , (  ) ),
+    ( ((1..19).list) , (  ) ),
+    ( ((1..20).list) , (  ) ),
+    ( ((1..21).list) , (  ) ),
+    ( ((1..22).list) , (  ) ),
+    ( ((1..23).list) , (
+        (2, 23, 13, 12, 4, 21, 15, 10, 6, 19, 17, 8, 1, 3, 22, 14, 11, 5, 20, 16, 9, 7, 18),
+        (9, 16, 20, 5, 11, 14, 22, 3, 1, 8, 17, 19, 6, 10, 15, 21, 4, 12, 13, 23, 2, 7, 18),
+        (18, 7, 2, 23, 13, 12, 4, 21, 15, 10, 6, 19, 17, 8, 1, 3, 22, 14, 11, 5, 20, 16, 9),
+        (18, 7, 9, 16, 20, 5, 11, 14, 2, 23, 13, 12, 4, 21, 15, 10, 6, 19, 17, 8, 1, 3, 22),
+        (18, 7, 9, 16, 20, 5, 11, 14, 22, 3, 1, 8, 17, 19, 6, 10, 15, 21, 4, 12, 13, 23, 2),
+        (22, 3, 1, 8, 17, 19, 6, 10, 15, 21, 4, 12, 13, 23, 2, 14, 11, 5, 20, 16, 9, 7, 18), ) ),
+    ( ((1..24).list) , (  ) ),
+    ( ((1..25).list) , (
+        (2, 23, 13, 12, 24, 25, 11, 14, 22, 3, 1, 8, 17, 19, 6, 10, 15, 21, 4, 5, 20, 16, 9, 7, 18),
+        (3, 22, 14, 2, 23, 13, 12, 4, 21, 15, 10, 6, 19, 17, 8, 1, 24, 25, 11, 5, 20, 16, 9, 7, 18),
+        (4, 21, 15, 10, 6, 19, 17, 8, 1, 3, 22, 14, 2, 23, 13, 12, 24, 25, 11, 5, 20, 16, 9, 7, 18),
+        (8, 17, 19, 6, 10, 15, 21, 4, 12, 13, 23, 2, 14, 22, 3, 1, 24, 25, 11, 5, 20, 16, 9, 7, 18),
+        (9, 16, 20, 5, 4, 21, 15, 10, 6, 19, 17, 8, 1, 3, 22, 14, 11, 25, 24, 12, 13, 23, 2, 7, 18),
+        (10, 15, 21, 4, 12, 13, 23, 2, 14, 22, 3, 6, 19, 17, 8, 1, 24, 25, 11, 5, 20, 16, 9, 7, 18),
+        (11, 25, 24, 12, 13, 23, 2, 14, 22, 3, 1, 8, 17, 19, 6, 10, 15, 21, 4, 5, 20, 16, 9, 7, 18),
+        (13, 23, 2, 14, 22, 3, 1, 8, 17, 19, 6, 10, 15, 21, 4, 12, 24, 25, 11, 5, 20, 16, 9, 7, 18),
+        (18, 7, 2, 23, 13, 12, 24, 25, 11, 14, 22, 3, 1, 8, 17, 19, 6, 10, 15, 21, 4, 5, 20, 16, 9),
+        (18, 7, 9, 16, 20, 5, 4, 21, 15, 10, 6, 19, 17, 8, 1, 3, 22, 14, 2, 23, 13, 12, 24, 25, 11),
+        (18, 7, 9, 16, 20, 5, 4, 21, 15, 10, 6, 19, 17, 8, 1, 3, 22, 14, 11, 25, 24, 12, 13, 23, 2),
+        (18, 7, 9, 16, 20, 5, 11, 25, 24, 1, 3, 22, 14, 2, 23, 13, 12, 4, 21, 15, 10, 6, 19, 17, 8),
+        (18, 7, 9, 16, 20, 5, 11, 25, 24, 1, 8, 17, 19, 6, 3, 22, 14, 2, 23, 13, 12, 4, 21, 15, 10),
+        (18, 7, 9, 16, 20, 5, 11, 25, 24, 1, 8, 17, 19, 6, 10, 15, 21, 4, 12, 13, 3, 22, 14, 2, 23),
+        (18, 7, 9, 16, 20, 5, 11, 25, 24, 1, 8, 17, 19, 6, 10, 15, 21, 4, 12, 13, 23, 2, 14, 22, 3),
+        (18, 7, 9, 16, 20, 5, 11, 25, 24, 12, 4, 21, 15, 10, 6, 19, 17, 8, 1, 3, 13, 23, 2, 14, 22),
+        (18, 7, 9, 16, 20, 5, 11, 25, 24, 12, 4, 21, 15, 10, 6, 19, 17, 8, 1, 3, 22, 14, 2, 23, 13),
+        (18, 7, 9, 16, 20, 5, 11, 25, 24, 12, 13, 23, 2, 14, 22, 3, 1, 8, 17, 19, 6, 10, 15, 21, 4),
+        (22, 14, 2, 23, 13, 3, 1, 8, 17, 19, 6, 10, 15, 21, 4, 12, 24, 25, 11, 5, 20, 16, 9, 7, 18),
+        (23, 2, 14, 22, 3, 13, 12, 4, 21, 15, 10, 6, 19, 17, 8, 1, 24, 25, 11, 5, 20, 16, 9, 7, 18), ) ),
+;
+use Test;
+plan 2+@tests;
+for @tests.head(2) -> ( @in, @expected ) {
+    is-deeply task2_slow(@in), @expected;
+}
+for @tests -> ( @in, @expected ) {
+    is-deeply task2(@in), @expected;
+}