Task — 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.

Analysis

This is a relatively simple task if:

• we are allowed to use a permutation generating module and
• we are not too concerned about performance.

So let's generate every permutation of @list using an imported module, and for each permutation test whether all adjacents pairs are square. How do we test that? Well, my first attempt was: sqrt($sum) == int(sqrt($sum))

So for example, if $sum is 9, that evaluates to 3 == 3 => true, but if $sum is 10 we get 3.1623 == 3 => false. It works, but the sqrt operation is probably quite slow, given that it may be invoked thousands or millions of times. Also, comparing two potentially non-integral numbers for equality is unwise.

So I went for developing a global sparse array of squares, such that $squares[$n ** 2] == $n. I don't prepopulate it, but simply extend it every time it is called to the point where $n ** 2 is greater than the sum being tested.

And that's my submitted solution. But there is another possible saving, which derives from the fact that for every squareful sequence, the reverse of it is also squareful, although if the sequence is symmetrical (eg 1, 3, 6, 3, 1) the reversed sequence is the same as the original one. So for each permutation we could check whether its reverse has already been processed, and if so skip it. Then, in generating the final output, we'd have to add in the reverse of every non-symmetrical sequence.

I said that this is a possible saving, because I am not convinced that the added processing in reversing and checking for prior use of each permutation would significantly save time over just checking all permutations - but I have not tested that assertion.

Try it 

#!/usr/bin/perl

use v5.16;    # The Weekly Challenge - 2023-06-05
use utf8;     # Week 220 task 2 - Squareful
use strict;   # Peter Campbell Smith
use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge

use Algorithm::Loops 'NextPermuteNum';
my (@squares);
$squares[0] = 0;

squareful(1, 17, 8);
squareful(2, 2, 2);
squareful(63, 1, 24, 12, 13, 3, 141, 28, 8, 1, 3);
squareful(1, 2, 3, 4, 5, 6, 7, 8, 9);

sub squareful {
    
    my ($successes, @list, $last, $good, $results, $j);
    
    # initialise
    $results = '';
    @list = sort { $a <=> $b } @_;
    $last = scalar @list - 2;
    
    # loop over permutations, testing for squarefulness
    do {
        $good = 1;
        for $j (0 .. $last) {
            
            # abandon this perm if a pair isn't a square
            unless (is_a_square($list[$j] + $list[$j + 1])) {
                $good = 0;
                last;
            }
        }
        if ($good) {
            $results .= '(' . join(', ', @list) . '), ';
        }
    } while (NextPermuteNum(@list));
    $results = 'No squareful permutation  ' unless $results;
    
    say qq[\nInput:  \@ints = (] . join(', ', @_) . ')';
    say qq[Output: ] . substr($results, 0, -2);
}

sub is_a_square {
    
    my ($test, $last_square, $next_number);
    
    $test = $_[0];
    
    # extend (if necessary) list of squares up to at least $test
    # eg $test[9] == 3
    while (1) {
        $last_square = scalar @squares - 1;
        last if $last_square >= $test;
        
        # need more
        $next_number = $squares[$last_square] + 1;
        $squares[$next_number ** 2] = $next_number;
    }
    return defined $squares[$test] ? 1 : 0;
}   

Output

Input:  @ints = (1, 17, 8)
Output: (1, 8, 17), (17, 8, 1)

Input:  @ints = (2, 2, 2)
Output: (2, 2, 2)

Input:  @ints = (63, 1, 24, 12, 13, 3, 141, 28, 8, 1, 3)
Output: (3, 1, 8, 28, 141, 3, 13, 12, 24, 1, 63), (3, 1, 24, 12, 13, 3, 141, 28, 8, 1, 63), (3, 1, 63, 1, 8, 28, 141, 3,
 13, 12, 24), (3, 1, 63, 1, 24, 12, 13, 3, 141, 28, 8), (3, 13, 3, 141, 28, 8, 1, 63, 1, 24, 12), (3, 13, 12, 24, 1, 3,
141, 28, 8, 1, 63), (3, 13, 12, 24, 1, 8, 28, 141, 3, 1, 63), (3, 13, 12, 24, 1, 63, 1, 3, 141, 28, 8), (3, 13, 12, 24,
1, 63, 1, 8, 28, 141, 3), (3, 141, 3, 13, 12, 24, 1, 63, 1, 8, 28), (3, 141, 28, 8, 1, 3, 13, 12, 24, 1, 63), (3, 141, 2
8, 8, 1, 24, 12, 13, 3, 1, 63), (3, 141, 28, 8, 1, 63, 1, 3, 13, 12, 24), (3, 141, 28, 8, 1, 63, 1, 24, 12, 13, 3), (8,
28, 141, 3, 1, 3, 13, 12, 24, 1, 63), (8, 28, 141, 3, 1, 24, 12, 13, 3, 1, 63), (8, 28, 141, 3, 1, 63, 1, 3, 13, 12, 24)
, (8, 28, 141, 3, 1, 63, 1, 24, 12, 13, 3), (8, 28, 141, 3, 13, 3, 1, 63, 1, 24, 12), (8, 28, 141, 3, 13, 12, 24, 1, 3,
1, 63), (8, 28, 141, 3, 13, 12, 24, 1, 63, 1, 3), (12, 24, 1, 3, 13, 3, 141, 28, 8, 1, 63), (12, 24, 1, 8, 28, 141, 3, 1
3, 3, 1, 63), (12, 24, 1, 63, 1, 3, 13, 3, 141, 28, 8), (12, 24, 1, 63, 1, 8, 28, 141, 3, 13, 3), (24, 12, 13, 3, 1, 3,
141, 28, 8, 1, 63), (24, 12, 13, 3, 1, 8, 28, 141, 3, 1, 63), (24, 12, 13, 3, 1, 63, 1, 3, 141, 28, 8), (24, 12, 13, 3,
1, 63, 1, 8, 28, 141, 3), (24, 12, 13, 3, 141, 3, 1, 63, 1, 8, 28), (24, 12, 13, 3, 141, 28, 8, 1, 3, 1, 63), (24, 12, 1
3, 3, 141, 28, 8, 1, 63, 1, 3), (28, 8, 1, 3, 141, 3, 13, 12, 24, 1, 63), (28, 8, 1, 24, 12, 13, 3, 141, 3, 1, 63), (28,
 8, 1, 63, 1, 3, 141, 3, 13, 12, 24), (28, 8, 1, 63, 1, 24, 12, 13, 3, 141, 3), (63, 1, 3, 1, 8, 28, 141, 3, 13, 12, 24)
, (63, 1, 3, 1, 24, 12, 13, 3, 141, 28, 8), (63, 1, 3, 13, 3, 141, 28, 8, 1, 24, 12), (63, 1, 3, 13, 12, 24, 1, 3, 141,
28, 8), (63, 1, 3, 13, 12, 24, 1, 8, 28, 141, 3), (63, 1, 3, 141, 3, 13, 12, 24, 1, 8, 28), (63, 1, 3, 141, 28, 8, 1, 3,
 13, 12, 24), (63, 1, 3, 141, 28, 8, 1, 24, 12, 13, 3), (63, 1, 8, 28, 141, 3, 1, 3, 13, 12, 24), (63, 1, 8, 28, 141, 3,
 1, 24, 12, 13, 3), (63, 1, 8, 28, 141, 3, 13, 3, 1, 24, 12), (63, 1, 8, 28, 141, 3, 13, 12, 24, 1, 3), (63, 1, 24, 12,
13, 3, 1, 3, 141, 28, 8), (63, 1, 24, 12, 13, 3, 1, 8, 28, 141, 3), (63, 1, 24, 12, 13, 3, 141, 3, 1, 8, 28), (63, 1, 24
, 12, 13, 3, 141, 28, 8, 1, 3)

Input:  @ints = (1, 2, 3, 4, 5, 6, 7, 8, 9)
Output: No squareful permutation