Re: magic squares

[tilly]

To solve this you have to do a brute force search. The trick is how to do a brute force search through a small enough set of possibilities that you can quickly come to an answer. My solution was to take all of the possible ways to put the given letters into a square, and see if I could fill out the rest of the square. The principle in question is that I have one constraint for each row, column and diagonal (8 constraints total). If that sum is not the canonical sum, then I don't have a solution. If it is, then I do have a solution.

The answer is:

<Reveal this spoiler or all in this thread>

My code is somewhat hastily put together and uses global variables and local in ways that I wouldn't recommend lightly using in production code. But here it is for those who are interested.

#! /usr/bin/perl
use strict;
use warnings;
use List::Util qw(sum);

# Global variables here for performance.
my @names = qw(JOHN MARTY PAUL SHEILA SMACK SUZY ELSA);
my @magic_square;
my $sum;
my @constraint_sets = (
  # Horizontal lines
  [0, 1, 2],
  [3, 4, 5],
  [6, 7, 8],
  # Vertical lines
  [0, 3, 6],
  [1, 4, 7],
  [2, 5, 8],
  # Diagonals
  [0, 4, 8],
  [2, 4, 6],
);

for my $name (@names) {
  print "Processing $name\n";
  find_squares($name);
}

sub find_squares {
  my @char = split //, shift;
  unless (@char > 3) {
    die "This method requires at least 4 letters\n";
  }
  my @d = map {1 + ord($_) - ord("A")} @char;
  solve(@d);
}

# The solution technique is to fill in the things we have into
# the square, then pick enough other spots in the square to
# constrain the what the rest of the square has, then check
# whether we have a solution.
sub solve {
  if (@_) {
    my $d = shift;
    for (0..8) {
      next if $magic_square[$_];
      local $magic_square[$_] = $d;
      solve(@_);
    }
  }
  else {
    my $constrain_2;
    for my $set (@constraint_sets) {
      my $count = grep $magic_square[$_], @$set;
      if (3 == $count) {
        $sum = sum(@magic_square[@$set]);
        last;
      }
      elsif (2 == $count) {
        $constrain_2 = $set;
      }
    }

    if ($sum) {
      fill_and_check();
    }
    elsif (not $constrain_2) {
      die "Can't find a constraint for 2 elements??";
    }
    else {
      my $i;
      for (@$constrain_2) {
        $i = $_ unless $magic_square[$_];
      }
      for (1..26) {
        local $magic_square[$i] = $_;
        $sum = sum(@magic_square[@$constrain_2]);
        fill_and_check();
      }
    }

    # And clear the global.
    $sum = undef;
  }
}

# Copy the square, and fill in using the sum.
sub fill_and_check {
  my @square = @magic_square;
  my $filled = 1;
  while ($filled) {
    $filled = 0;
    for my $set (@constraint_sets) {
      my $count = grep $square[$_], @$set;
      if (3 == $count) {
        if (sum(@square[@$set]) != $sum) {
          # Not a magic square
          return;
        }
      }
      elsif (2 == $count) {
        my $s = sum(grep $_, @square[@$set]);
        if ($s >= $sum or $s < $sum - 26) {
          # We'd need a number out of range, can't fill.
          return;
        }
        else {
          my $i;
          for (@$set) {
            $i = $_ unless $square[$_];
          }
          $square[$i] = $sum - $s;
          $filled++;
        }
      }
    }
  }

  # I now have a magic square but it may not be unique.
  my %seen;
  for my $i (0..8) {
    if (not defined($square[$i])) {
      # This happens when we fill in the following pattern.
      #
      #  ?_?
      #  ___
      #  ?_?
      #
      # So just try possibilities recursively.
      my @old_square = @magic_square;
      @magic_square = @square;
      for (1..26) {
        local $magic_square[$i] = $_;
        fill_and_check();
      }
      @magic_square = @old_square;

      # No need to proceed, we already did recursively.
      return;
    }
    return if $seen{$square[$i]}++;
  }

  # We have a real magic square.  Now print it.
  print "  ", map {chr($_ + ord("A") - 1)} @square;
  print "\n";
}

[sflitman]

I stand in awe. That's the solution I would've coded if I knew how...and it ran very fast.

Thanks for tackling the problem!

SSF