## TWC 220: Squared Shoulders

In which we move beyond Perfect Permutation.

# TWC Task #1 - Common Characters

Given a list of words, return the sorted list of the characters common to every word.

## Raku

Map each word into a `Set` of characters, take the intersection of those `Set`s.

``````sub task1 ( @words --> Seq ) {
return sort keys [∩] map *.lc.comb.Set, @words;
}
``````

I needed `keys` because `Set`s are represented like `Hash`es of `KEY => True`, and we only want the key.

`.Set` was not actually needed within the `map`, because the intersection operator would interpret its input as `Set`s. I made it explicit for clarity.

## Perl

Build a Bag of `(character => count)`, then extract those characters with the same count as the number of words.

``````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 ];
}
``````

Note that `uniq` is key to making this work, otherwise multiples of a character within a word would fool the logic.

# TWC Task #2 - Squareful

Given a list of integers, return all the permutations that are "squareful" (the sum of every adjacent pair is a perfect square).

## Observations:

• We will need:

1. A way to identify a perfect square.

2. A way to either: A. identify that all adjacent pairs have a property, and a way to filter all permutations against it, or B. permute with early identification that some adjacent pair lack the property.

• I use `\$n.sqrt.round.² == \$n` (in Raku) or `(int(sqrt \$n) ** 2) == \$n` (in Perl) to spot perfect squares. Other methods that do not re-square the integer portion of the square root, such as `.sqrt == .sqrt.Int` and `.sqrt % 1`, will fail at `(2 ** 26)² == 67108864²` and above. `.sqrt.narrow ~~ Int` fails at `22351742²`.

• In Raku, `sub task2_slow` is my "permute and filter" solution. I did not use that approach in Perl.

• Handling our own permutation via recursion allows us to terminate branches early when we detect a failure, offering a huge performance increase. For example, `[1..8]` would have `8! == 40320` permutations, but we only have to check `24` of them.

## Raku

Subroutine `task2` can handle my whole test suite (which includes `[1..25]`) in 3 seconds.

``````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 gather for %square_pairs{\$head}{\$n_count.keys}:k -> \$c {
\$n_count{\$c}--;
.take for recursing( \$c ).map({ \$head, |\$_ });
\$n_count{\$c}++;
}
}

return sort gather for \$n_count.keys -> \$head {
}
}
``````

## Perl

Translation of the Raku code, with these notable changes:

1. My implementation of Bag is "insulated".

2. \$square_pairs{\$x}{\$y} = \$y; Set up for :k-replacing all-square-candidates

Note also the use of `__SUB__` to recurse from within a anonymous sub.

``````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_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};
}

my \$recursing = sub ( \$head ) {

my @ret;
for my \$c (grep {defined} @{\$square_pairs{\$head}}{\$bag_keys->()}){
\$bag_del->(\$c);
push @ret, map { [\$head, @{\$_} ] } __SUB__->( \$c );
}
return @ret;
};

my @ret;
for my \$head ( \$bag_keys->() ) {