This week's Puzzlet revisits a favourite theme - Pandigitals.  However, there's a twist (well, what do you expect from a Puzzlet?).  The Pandigital has to be made up from three perfect squares!

' Puzzlet #010.
' Break a 9-digit pandigital into 3 groups
' of perfect squares.  Reminder: a 9-digit
' pandigital is an integer which uses each
' of the digits 1 to 9 inclusive once and
' once only.  Find all possible solutions.
' Example solution: 25, 784, 1369, which
' corresponds to 5^  2, 28^  2, and 37^  2.
' By Dave Ellis.

declare NoZeroes(n$: string)
declare AllDigsDiff (n$: string)
declare CountSquares()
declare LoadSquares()
def a, b, c, cntr, nrSquares: int
def a$, b$, c$, d$: string

openconsole
print "Generating legal squares ..."
nrSquares = CountSquares()
print: print nrSquares, "found."
def squares[nrSquares + 1]: string
print: print "Loading and sorting ..."
LoadSquares()
cntr = 0
print: print "Checking combinations ..."
print
a = 1
do
    a$ = squares[a]
    for b = a + 1 to nrSquares - 1
        b$ = squares[b]
        for c = b + 1 to nrSquares
            c$ = squares[c]
            d$ = a$ + b$ + c$
            if len(d$) = 9
                if AllDigsDiff(d$)
                    cntr = cntr + 1
                    print a$, " ", b$, " ", c$
                endif
            endif
        next c
    next b
    a = a + 1
until len(squares[a]) > 3   

print:print cntr, "different solutions."
print:print "Press any key to close ..."
do: until inkey$ <> ""
closeconsole
end

sub NoZeroes(n$)
' returns -1 if n$ doesn't contain the
' character "0" at least once, otherwise
' returns 0
def flag, L, it: int
L = len(n$)
flag = -1
it = 1
do
    if mid$(n$,it,1) = "0"
        flag = 0
    endif
    it = it + 1
until flag = 0 | it > L
return flag

sub AllDigsDiff(n$)
' if no two digits of n$ are identical,
' returns -1, otherwise returns 0
def flag, it1, it2, L, test: int
L = len(n$)
if L < 2
    test = val(n$)
    select test
        case 1, 4, 9
            flag = -1
        default
            flag = 0
    endselect
else
    L = len(n$)
    it1 = 1
    flag = -1
    do
        it2 = it1 + 1
        do
            if mid$ (n$,it1,1) = mid$(n$,it2,1)
                flag = 0
            endif
            it2 = it2 + 1
        until flag = 0 | it2 > L
        it1 = it1 + 1
    until flag = 0 | it1 = L
endif
return flag

sub CountSquares
' makes a tally of every perfect square
' below 10 million which which doesn't
' contain any zeroes or any repeated
' digits and returns the count
def count, i, j: int
def j$: string
count = 0
for i = 1 to 31426
    j = i * i
    j$ = ltrim$(str$(j))
    if NoZeroes(j$)
        if AllDigsDiff(j$)
            count = count + 1
        endif
    endif
next i
return count

sub LoadSquares
' loads the global array squares[] with
' perfect squares having a value less
' than 10 million, and all of which contain
' no zeroes or repeated digits.
def count, i, j: int
count = 0
for i = 1 to 31426
    j = i * i
    j$ = ltrim$(str$(j))
    if NoZeroes(j$)
        if AllDigsDiff(j$)
            count = count + 1
            squares[count] = j$
        endif
    endif
next i
return

PROGRAM NOTES

Before the program gets properly underway, it needs to do some background work.  The first task is to find out just how many squares are possible within the constraints of a 9-digit pandigital.   The requirements for any square must be:

• it must not contain any zeroes
• it must not contain any repeated digits
• it must not be larger than 987654321 (approximately 31426 ² )

The subroutine CountSquares() takes care of that task,  placing the returned value in the variable nrSquares.

Now we have enough information to create an array to hold all those squares, appropriately names squares[].  This is sized at (nrSquares + 1), since IBasic arrays counting from zero.  since squares[] is now correctly sized, it can be loaded, and the subroutine LoadSquares takes care of that.

Now the main routine can begin its magnus opus, as it were, by initialising variables a and ctrl and then opening its DO loop.

We want to look at every possible combination of 3 squares as contained in squares[].  If such a combination can be concatenated as a pandigital, we have a solution.  

Now, it turns out that there are 204 squares available to us that meet the criteria of no zeroes and no repeated digits (the program above actually prints out this total for your edification).  There are 1,394,204 combinations of 3 things from 204, so the computer has to do a fair bit of work to find and check them all.

This task is accomplished using variables a, b, and c as iterators to pull out the combinations from squares[] within the DO loop.  The iterators point to different squares, which are then stored temporarily in the string variables, a$, b$, and c$. At each step they are concatenated into variable d$ for checking.

If d$ has a length of 9, and all its digits are different (validated by using the function AllDigsDiff(), would you believe?), it must be a valid solution, and is printed to the screen.  The variable cntr is updated, as this will be used later to give statistical information about the results.

That's about it, folks.  I haven't given a breakdown of every single subroutine and function - top down programming doesn't really require that.  However, if you'd like more detail on how those little devils work, please contact me and I'd be delighted to give an even more detailed breakdown for you.

When you run the code, it produces the inset screen. The user is kept informed of what's going on by a series of little messages. The program begins by telling you that it's busy generating all legal squares (those that don't contain any zeroes, and have all different digits). When it finishes this task, it announces how many squares were found - 204 in this case. Then, while loading these legal square into the array squares[] and sorting them, it announces this to the user. Finally, it begins the somewhat cumbersome task of checking all possible combinations of 3 squares stored in the array, and checking to see whether they can be concatenated into a pandigital. Every time one is found it's printed out to the screen. When all possible combinations have been found and printed out, the total number of solutions is announced and the program terminates.

Generating legal squares ... 204 found. Loading and sorting ... Checking combinations ... 1 4 3297856 1 4 3857296 1 4 5827396 1 4 6385729 1 4 8567329 1 4 9572836 1 49 872356 1 64 537289 1 256 73984 1 625 73984 4 16 537289 4 25 139876 4 25 391876 4 289 15376 9 324 15876 16 25 73984 16 784 5329 25 784 1369 25 784 1936 25 841 7396 36 81 74529 36 81 79524 36 729 5184 81 324 7569 81 576 3249 81 729 4356 361 529 784 27 different solutions. Press any key to close ...