Perl Weekly Challenge 220: Squareful Arrays
These are some answers to the Week 220, task 2, of the Perl Weekly Challenge organized by Mohammad S. Anwar.
Spoiler Alert: This weekly challenge deadline is due in a few days from now (on June 11, 2023 at 23:59). This blog post offers some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.
Squareful Arrays
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.
Squareful Arrays in Raku
The is-squareful
subroutine uses the rotor method with batch size of 2 and an overlap of -1 to generate each adjacent pair in the input array, sums the value of each such pair and returns True
if all sums are perfect square. The find-squareful
subroutine generates all permutations of the input list and keeps those that are squareful. Note that it uses a SetHash
to store the permutations, so as to remove possible duplicate permutations.
sub is-squareful (@in) {
for @in.rotor(2 => -1) -> @list {
my $sum = [+] @list;
return False if ($sum.sqrt.Int)² != $sum;
}
return True;
}
sub find-squareful (@in) {
my $result = SetHash.new;
for @in.permutations -> $perm {
$result{"($perm)"}++ if is-squareful $perm;
}
return join ", ", $result.keys;
}
for <1 17 8>, <17 1 8>, <2 2 2> -> @test {
say @test, " => ", find-squareful @test;
}
This program displays the following oputput:
$ raku ./squareful-arrays.raku
(1 17 8) => (17 8 1), (1 8 17)
(17 1 8) => (1 8 17), (17 8 1)
(2 2 2) => (2 2 2)
Wrapping up
The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on June 18, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.
Leave a comment