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

About laurent_r

user-pic I am the author of the "Think Perl 6" book (O'Reilly, 2017) and I blog about the Perl 5 and Raku programming languages.