sflitman has asked for the
wisdom of the Perl Monks concerning the following question:
Greetings and felicitations! I have been cracking my head on this problem from New Scientist all day. Here is my code.
#!/usr/bin/perl
# SSF 040409  New Scientist Enigma 1537  21 March 2009
# borrows heavily from Juerd's Math::MagicSquare::Generator
use strict;
my @names=qw(JOHN MARTY PAUL SHEILA SMACK SUZY ELSA);
my ($text,%squares);
generate_magic_squares(\%squares);
print "Magic squares:\n";
map { print "$_\n" } sort keys %squares;
print "Names in squares:\n";
map { print "$_: $text\n" if match_squares(\%squares,\$text,$_) } @nam
+es;
exit;
sub generate_magic_squares { # generate 3x3 squares
my ($lst)=@_;
my ($square,$start,$step);
for $step (1..10) {
for $start (1..26) {
$square=generate_magic_square($start,$step);
print as_string($square);
if (check($square)) {
print "PASS\n";
$lst>{ as_letters($square) }++;
} else {
print "FAIL\n";
}
}
}
}
sub as_letters {
my ($self)=@_;
return join('',map { join('',map { chr(64+$_) } @$_) } @$self);
}
sub as_string {
my ($self) = @_;
return map { join(' ', map { chr($_+64) } @$_) . "\n" } @$self;
}
sub _sum {
my $sum = 0;
$sum += $_ for @_;
return $sum
}
sub check {
my ($self) = @_;
my $sum = _sum( @{ $self>[0] } );
# Horizontals
for (@$self[1..$#$self]) {
return undef if @$_ > @$self; # undef if not square
return undef if _sum(@$_) != $sum;
}
# Verticals
for my $x (0..$#$self) {
return undef if _sum(map $self>[$_][$x], 0..$#$self) != $sum;
}
# Diagonals
return undef if _sum(map $self>[$_][$_], 0..$#$self) !=
+ $sum;
return undef if _sum(map $self>[$#$self  $_][$_], 0..$#$self) !=
+ $sum;
# Duplicates
my %seen;
$seen{$_}++ for map @$_, @$self;
return undef if _sum(values %seen) != keys %seen;
# Passed all tests!
return $sum;
}
sub generate_magic_square { # 3x3, taken from Math::MagicSquare::Gen
+erator
my ($start,$step)=@_;
my $self = [
map {
[ (undef) x 3 ]
} 1..3
];
my $value = $start;
my $halv = int(@$self / 2);
for my $start_x ($halv..$halv) {
my $x = $start_x  1;
my $y = $x + @$self + 1;
for (1 .. @$self) {
$x = $x  @$self if ++$x > $#$self;
$y = $y  @$self if $y > $#$self;
$self>[$y][$x] = $value;
$value += $step;
if ($value>26) { $value=26; }
}
}
$self;
}
sub match_squares { # are there keys which contain letters of nam
+es
my ($lst,$text,$name)=@_;
my @lst=keys %$lst;
for my $letter (split(//,$name)) {
@lst=grep { index($_,$letter)>1 } @lst;
}
$$text=join(' ',@lst);
@lst ? 1 : 0;
}
I only get the following output:
JOHN: HMLOKGJIN INMPLHKJO
MARTY: RATOMKFYH
SMACK: MASQKECUI
SUZY: SXWZVRUTY
So I know the solution is PAUL, SHEILA, or ELSA. What am I missing? I think it could be that Juerd's algorithm (which actually dates back to the 17th century and probably long before, called the
Siamese method) does not generate all possible 3 x 3 magic squares with the numbers 1..26, but I'm not sure how to code other methods.
Any comments appreciated!
SSF
Re: magic squares
by tilly (Archbishop) on Apr 05, 2009 at 17:42 UTC

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:
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.
 [reply] [d/l] 

 [reply] 
Re: magic squares
by blokhead (Monsignor) on Apr 05, 2009 at 13:47 UTC

The Siamese method you linked to seems to be only applicable for n x n squares made up of the numbers 1 through n^{2}. In this problem you are asked about 3 x 3 magic squares made up of numbers 1 through 26. So there is much less structure and the Siamese method (even augmented as you have done) will likely not find all such squares.
Unless you happen to fall upon an ingenious simple mathematical simplification, there may be nothing much simpler than trying all possible arrangements of 9 numbers chosen between 1 and 26.
So I would start the other direction, so that there is less to search. Start with the person's name, say PAUL, and figure out which sets of 5 letters could be added to make a magic square. There are some simple constraints that limit the amount of search, for instance the sum of all the entries should be a multiple of 3. Then see if you can make a magic square out of it. It will be less work than searching the entire space.
 [reply] 

That's what I thought. I wrote some code with Algorithm::Combinatorics and it took bloody forever so I knew it had to be wrong. I like the idea of constrained search, with all 9 entries summing to multiple of 3, but the problem is the arrangement of the PAUL letters can be anywhere in the grid, so I'm stuck searching permutations anyway.
Thanks for your input!
SSF
 [reply] 

blokhead,
Actually, I don't think brute forcing to the extent you are describing is necessary. Is there any way you can confirm or deny my hunch that says any 3x3 magic square will have a center value of the magic constant divided by 3? If that assumption holds, I can think of a much smarter way of approaching this.
Update: In the CB, tye has shown that this assumption is true. I believe these squares can be constructed rather than validating random permutations. If I get a chance, I will provide a solution tonight. He also pointed out that you can't have the max nor the min values in one of the corners.
 [reply] 

It may help you quite a bit to realize that some linear algebra shows that all solutions are of the form:
x+y xz xy+z
x2y+z x x+2yz
x+yz x+z xy
By rotating and reflecting we can make the largest corner be x+y, and we can insist that xz > x2y+z. In this case we have 0 < z < y The condition that all values be in the range 1..26 is satisfied if 1 <= x2y+z < x+2yz <= 26. Uniqueness is satisfied if 2z != y.
We can actually make a stronger statement. If 2z < y, then the elements fall in the order x2y+z, xy, xy+z, xz, x, x+z, x+yz, x+y, x+2yz and if y < 2z then the elements fall in the order x2y+z, xy, xz, xy+z, x, x+yz, x+z x+y, x+2yz.
With this many conditions, it should not be hard to enumerate the magic squares up to symmetry. And with some cleverness, I believe you don't even have to enumerate them all.  [reply] [d/l] [select] 



Re: magic squares
by ELISHEVA (Prior) on Apr 05, 2009 at 08:15 UTC

 [reply] [d/l] 

Henry Higgins: By George, she's got it, By George, she's got it. (or so I hope). I finally managed to debug the script and changed the solution strategy... and who do you think doesn't have a magic square to show the teacher?
On my system the script took 0.69s between 0.40 and 0.48s to print the above output.
The code follows:
Update: moved end of spoiler section.
Update: made two small changes to increase speed by 3040%
 [reply] [d/l] [select] 

 [reply] 


Re: magic squares
by Limbic~Region (Chancellor) on Apr 10, 2009 at 13:41 UTC

sflitman,
Ok, I have one final contribution. This solution is still roughly O(N) where N is the number of names to check but it turns looking through the 206 unique squares into a hash lookup. It also has a couple of advantages over my previous solution. It only precalculates all solutions once and subsequently loads them from disk. Additionally, it displays all matching solutions, not just the first one found.
#!/usr/bin/perl
use strict;
use warnings;
use Storable;
my $db = 'msquare_solutions.db';
if (! e $db) {
my %possible;
for my $x (5 .. 22) {
for my $y (grep {$_ != $x} 1 .. int((25  $x) / 2)) {
my $max = 26  $x  2 * $y;
my $min = $x  2 * $y  1;
for my $z (grep {$_ != $x && $_ != $y} 1 .. ($min < $max ?
+ $min : $max)) {
my @square = (
($x + $y), ($x + $z), ($x  $y  $z),
($x  2 * $y  $z), ($x), ($x + 2 * $y + $z)
+,
($x + $y + $z), ($x  $z), ($x  $y)
);
my @sol = map chr($_ + 64), @square;
my $pow_iter = powerset(sort @sol);
while (my @set = $pow_iter>()) {
my $key = join '', @set;
push @{$possible{$key}}, \@sol;
}
}
}
}
store(\%possible, $db);
}
my $possible = retrieve($db);
for (qw/PAUL JOHN MARTY SHEILA SMACK SUZY ELSA/) {
my $key = join '', sort split //;
if ($possible>{$key}) {
for my $square (@{$possible>{$key}}) {
print "$_ is contained within '@$square'\n";
}
}
else {
print "No solution for $_\n";
}
}
sub powerset {
# Choose any powerset iterator you want  ensure ascending order o
+utput
# I used my own from [id://394168]
die "Implementation left as an exercise for the user";
}
 [reply] [d/l] 
Re: magic squares
by Limbic~Region (Chancellor) on Apr 10, 2009 at 00:01 UTC

sflitman,
I finally have a solution I am happy with. It only loops 206 times as that's how many possible 3x3 magic squares using 126 there are. Of course, I spent far more of my time (not to mention tilly and tye) figuring out how to get this solution then it would have taken just to let a naive brute force run. Enjoy. This should scale something close to O(N) where N is the number of names that you want to check.
#!/usr/bin/perl
use strict;
use warnings;
my @possible;
for my $x (5 .. 22) {
for my $y (grep {$_ != $x} 1 .. int((25  $x) / 2)) {
my $max = 26  $x  2 * $y;
my $min = $x  2 * $y  1;
for my $z (grep {$_ != $x && $_ != $y} 1 .. ($min < $max ? $mi
+n : $max)) {
my @square = (
($x + $y), ($x + $z), ($x  $y  $z),
($x  2 * $y  $z), ($x), ($x + 2 * $y + $z),
($x + $y + $z), ($x  $z), ($x  $y)
);
push @possible, join '', map chr($_ + 64), @square;
}
}
}
NAME:
for (qw/PAUL JOHN MARTY SHEILA SMACK SUZY ELSA/) {
for my $square (@possible) {
my $name = $_;
$name =~ s/[$square]//g;
if (! length($name)) {
print "$_ is contained within $square\n";
next NAME;
}
}
print "No solution for $_\n";
}
 [reply] [d/l] 

Nit. There are actually 1648 magic squares. Rotation and reflection can generate the rest from the 206 that you are producing.
 [reply] 
Re: magic squares
by ig (Vicar) on Apr 06, 2009 at 12:31 UTC

Treating the constraints as a set of linear equations reduces the number of free variables to three, which is not an unreasonable number to explore by brute force.
 [reply] [d/l] 

