### Perl Weekly Challenge: Week 220

#### Challenge 1:

**Common Characters**

You are given a list of words.

Write a script to return the list of common characters (sorted alphabeticall) found in every word of the given list.

##### Example 1

```
Input: @words = ("Perl", "Rust", "Raku")
Output: ("r")
```

##### Example 2

```
Input: @words = ("love", "live", "leave")
Output: ("e", "l", "v")
```

Everyone loves one-liners right? Here's a one-liner in Raku that solves this challenge.

Starting from the middle and working outwards, first the command-line arguments which represent words
are split into arrays of characters with `.map()`

and `.comb()`

. A second `.map()`

also converts the
characters to lower case. The `[∩]`

operator returns the intersection of these arrays. The return type is
a `Set`

which is a kind of hash so you need `.keys()`

to actually get the intersecting characters out. The characters are then sorted in ascending alphabetical order with `.sort()`

and the rest of the code is just
for printing them out nicely in the style of the examples.

```
say q{("}, ([∩] @*ARGS.map({ $_.comb.map({ $_.lc }) })).keys.sort.join(q{", "}), q{")}
```

Perl, as usual, requires more work. I had to make my own quick and dirty `intersection()`

function which looks like this:

```
sub intersection {
```

It takes two parameters, a reference to an list of arrays and the number of arrays. I probably didn't need the second parameter as this can be calculated based on the first but I told you this is quick and dirty.

```
my ($arrays, $n) = @_;
```

Every character in each array is counted in a hash imaginatively named `%count`

. The keys of this
hash are the characters and the values the number of times the character occurs.

```
my %count;
for my $arr (@{$arrays}) {
for my $char (@{$arr}) {
$count{$char}++;
}
}
```

If the number of occurrences is greater than `$n`

it means the character has occurred in every set. Well, this does
coincidentally work for the examples but it easily might not. For instance the input `("aaa", "b" "c")`

would
falsely return "a" as the intersection. Did I mention that this is quick and dirty?

The proper way I think would have been to first find the unique characters in each separate array and then add
them to `%count`

.

```
return grep { $count{$_} >= $n} keys %count;
}
```

Whatever the merits of `intersection()`

, armed with it, the rest of the script works the same as the Raku version.

```
my @words = map { [map { lc } split //] } @ARGV;
my @common = intersection(\@words, scalar @ARGV);
say q{("}, (join q{", "}, sort @common), q{")};
```

#### Challenge 2:

**Squareful**

You are given an array of integers, @ints.

An array is squareful if the sum of every pair of adjacent elements is a perfect square.

Write a script to find all the permutations of the given array that are squareful.

##### Example 1

```
Input: @ints = (1, 17, 8)
Output: (1, 8, 17), (17, 8, 1)
(1, 8, 17) since 1 + 8 => 9, a perfect square and also 8 + 17 => 25 is perfect square too.
(17, 8, 1) since 17 + 8 => 25, a perfect square and also 8 + 1 => 9 is perfect square too.
```

##### Example 2

```
Input: @ints = (2, 2, 2)
Output: (2, 2, 2)
There is only one permutation possible.
```

Once I understood what the problem was actually trying to say, this became quite simple in Raku.

This is a variable which will hold our results.

```
my @results;
```

Then we find all the permutations of the input array with `.permutations()`

.

```
for @ints.permutations -> $perm {
```

At the start we are going to optimistically assume the permutation is squareful.

```
my $squareful = True;
```

Then we go through each pair of elements in the permutation...

```
for 1 .. @$perm.end -> $n {
```

...check if the square root of their total is an integer. If it is not...

```
if sqrt(@$perm[$n - 1] + @$perm[$n]) % 1 != 0 {
```

the permutation is not squareful; we can abandon ship.

```
$squareful = False;
last;
}
}
```

If it turns out to actually be squareful, the permutation is joined up into a string and
added to `@results`

. The extra text which is concatenated is to help make the output look
like that in the example.

```
if $squareful {
@results.push(q{(} ~ @$perm.join(q{, }) ~ q{)});
}
}
```

Once we have all the results, we can print them out comma-separated. There is one small step to
take first. `.permutations()`

doesn't distinguish between i.e. `(1, 2, 3)`

and `(3,2, 1)`

; it will
treat them as different permutations so we may end up with duplicates in our output. (As with example 2
for instance.) So we have to add a call to `.unique()`

to filter those duplicates out.

```
@results.unique.join(q{, }).say;
```

Translating my Raku solution to Perl had the perennial problem of missing functionality. Luckily I have
long had `permute()`

and `unique()`

routines from previous challenges so that wasn't a big deal.

```
my @results;
my @permutations;
permute { push @permutations, \@_; } @ARGV;
for my $perm (@permutations) {
```

Also using `1`

and `undef`

instead of the missing `True`

and `False`

is also trivial to change.

```
my $squareful = 1;
for my $n (1 .. scalar @{$perm} - 1) {
```

But what really gave me a hard time is that the `%`

operator works differently in Perl. I don't
know if it is mathematically "better" or "worse" than the way Raku's version works but I was unable
to get it to provide the same functionality.

So Instead I made getting the square root of a pair of elements a separate step.

```
my $root = sqrt($perm->[$n - 1] + $perm->[$n]);
```

I used that value and ran it through the `int()`

function. If the two numbers are unequal this means
the square root is not an integer. Again, being mathematically challenged, I don't know if there is
a simpler work around but this worked for me.

```
if ($root != int $root) {
$squareful = undef;
last;
}
}
if ($squareful) {
push @results, q{(} . (join q{, }, @{$perm}) . q{)};
}
}
say join q{, }, unique(@results);
```