Michał Wojciechowski

Every now and then, I enjoy solving logic puzzles (or attempting to). Recently I came across this one:

+----+----+----+
|    |  3 | 17 |
+----+----+----+
|  5 |    |    |
+----+----+----+
| 13 |    |  7 |
+----+----+----+

There are five prime numbers in a 3x3 grid, and the goal is to fill in the empty cells with four other prime numbers, so that the sum of every row, every column, and both diagonals is also a prime number, less than 100. Each number can only be used once, and this applies to the numbers in the grid as well as to all the sums. Lastly, the sum of all these numbers must be a prime number as well (greater than 100, obviously).

I took me quite a while to find a solution — but when I finally did, I had not one, but (at least) two solutions. The puzzle description didn’t mention anything about multiple solutions, so I thought I made a mistake along the way. However, having triple-checked all the math, I couldn’t find any errors. I decided it was time to use the force (I couldn’t miss the opportunity to use this phrase, considering the date when I’m posting this) — namely, the brute force.

My plan was to write a quick little program to verify all the possible solutions, and thus find out if a) there is indeed more than one correct solution, and b) the ones I found are among the correct ones. And, since recently I have started playing with Perl 6, I thought it might be fun to use it for this purpose.

Checking all possible solutions meant filling in the blanks with all four-element permutations of prime numbers less than 100 (excluding the ones already there in the grid) — so I first generated a list of numbers to pick from. This was trivial with the built-in is-prime method:

my @primes = grep *.is-prime, 1..100;

I eliminated the already used numbers using the set difference operator (-) (and the keys subroutine, since I wanted an array instead of a set):

@primes = keys @primes (-) (3, 5, 7, 13, 17);

I then had to check every permutation of four numbers from that list — in other words, select all possible four-element combinations and work out all their permutations. Perl 6 apparently comes with batteries and a nuclear reactor included, so there are built-in methods for combinations and permutations. Getting what I wanted was then easy-peasy:

.permutations for @primes.combinations(4)

With the help of the prefix | operator, I passed all those four-element lists to the not-yet-written check subroutine:

check(|$_) for (|.permutations for @primes.combinations(4));

The purpose of the check subroutine was to verify if the semi-random set of numbers happened to form a correct solution, by applying all the puzzle’s rules. I named the arguments based on their corresponding column/row indices:

sub check($a11, $a22, $a32, $a23) {

The first thing to do was to put the numbers into the grid, represented by a two-dimensional array:

    my @grid = (
        $a11,    3,   17 ;
           5, $a22, $a32 ;
          13, $a23,    7
    );

I then calculated the column/row/diagonal sums (the reduction meta operator was very helpful here), and put all the numbers in a single array:

    my @numbers = (
        |@grid[0], ([+] @grid[0]),              # First row, sum of first row
        |@grid[1], ([+] @grid[1]),              # Second row, sum of second row
        |@grid[2], ([+] @grid[2]),              # Third row, sum of third row
        @grid[0;2] + @grid[1;1] + @grid[2;0],   # Sum of anti-diagonal
        ([+] @grid[^3;0]),                      # Sum of first column
        ([+] @grid[^3;1]),                      # Sum of second column
        ([+] @grid[^3;2]),                      # Sum of third column
        @grid[0;0] + @grid[1;1] + @grid[2;2]    # Sum of main diagonal
    );

Having collected all the numbers, I needed to check if they satisfied the puzzle’s conditions. First, I checked if there were no duplicate numbers, by comparing the array against the list of its unique elements:

    return if @numbers != @numbers.unique;

Then, I checked for any numbers that were not prime or were greater than 100:

    return if grep { !$_.is-prime || $_ > 100 }, @numbers;

The last thing to do was to calculate the sum of all the numbers and check if it was prime as well:

    return if !is-prime [+] @numbers;

If the candidate solution made it this far, it had to be correct — so I wanted it printed out. With the numbers nicely arranged in a single flat array, it was easy to make a simple ASCII-art diagram-like format string (using the fancy new q:to heredoc syntax):

    my $fmt = q:to "END";

         | %3s | %3s | %3s |   %3s
         +-----+-----+-----+
         | %3s | %3s | %3s |   %3s
         +-----+-----+-----+
         | %3s | %3s | %3s |   %3s
        /                   \
     %3s   %3s   %3s   %3s   %3s

                 %3s
END

…and pass it to good old printf along with all the prime numbers and the final sum appended at the end:

    printf $fmt, @numbers, [+] @numbers;

And with that, my brutal solution was complete — it was time for the moment of truth. I ran the program, and was soon happy to see that it found both my solutions, as well as two other ones. Hooray, I might not be a moron after all!

Armed with this hard proof, I contacted the author of the puzzle to ask about the multiple solutions. It turned out the description was in fact missing one crucial sentence — it should have stated that there was more than one solution, and the correct one was that for which the final sum was the smallest. Solved, both the puzzle and the mystery.

Thanks, Perl 6! A++, will use again.

Here’s the complete code:

#!/usr/bin/env perl6

my @primes = grep *.is-prime, 1..100;
@primes = keys @primes (-) (3, 5, 7, 13, 17);

check(|$_) for (|.permutations for @primes.combinations(4));

sub check($a11, $a22, $a32, $a23) {
    my @grid = (
        $a11,    3,   17 ;
           5, $a22, $a32 ;
          13, $a23,    7
    );

    my @numbers = (
        |@grid[0], ([+] @grid[0]),              # First row, sum of first row
        |@grid[1], ([+] @grid[1]),              # Second row, sum of second row
        |@grid[2], ([+] @grid[2]),              # Third row, sum of third row
        @grid[0;2] + @grid[1;1] + @grid[2;0],   # Sum of anti-diagonal
        ([+] @grid[^3;0]),                      # Sum of first column
        ([+] @grid[^3;1]),                      # Sum of second column
        ([+] @grid[^3;2]),                      # Sum of third column
        @grid[0;0] + @grid[1;1] + @grid[2;2]    # Sum of main diagonal
    );

    return if @numbers != @numbers.unique;

    return if grep { !$_.is-prime || $_ > 100 }, @numbers;

    return if !is-prime [+] @numbers;

    my $fmt = q:to "END";

         | %3s | %3s | %3s |   %3s
         +-----+-----+-----+
         | %3s | %3s | %3s |   %3s
         +-----+-----+-----+
         | %3s | %3s | %3s |   %3s
        /                   \
     %3s   %3s   %3s   %3s   %3s

                 %3s
END

    printf $fmt, @numbers, [+] @numbers;
}