Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

magic squares

by sflitman (Hermit)
on Apr 05, 2009 at 02:19 UTC ( #755502=perlquestion: print w/ replies, xml ) Need Help??
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

Comment on magic squares
Select or Download Code
Re: magic squares
by ELISHEVA (Prior) on Apr 05, 2009 at 08:15 UTC
    And the solution is .... (withdrawn - too many bugs and faulty logic. But I've keep the code in case anyone wants to play with it.).

    Update: withdrew solution due to bugs

      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 30-40%

        There is still a bug in your logic. There are over 70 magic squares with all of the letters J O H N and you didn't find most of them.

        Update: I misread the format that ELISHEVA printed her results in. My bad.

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 n2. 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.

    blokhead

      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

      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.

      Cheers - L~R

        It may help you quite a bit to realize that some linear algebra shows that all solutions are of the form:
        x+y x-z x-y+z x-2y+z x x+2y-z x+y-z x+z x-y
        By rotating and reflecting we can make the largest corner be x+y, and we can insist that x-z > x-2y+z. In this case we have 0 < z < y The condition that all values be in the range 1..26 is satisfied if 1 <= x-2y+z < x+2y-z <= 26. Uniqueness is satisfied if 2z != y.

        We can actually make a stronger statement. If 2z < y, then the elements fall in the order x-2y+z, x-y, x-y+z, x-z, x, x+z, x+y-z, x+y, x+2y-z and if y < 2z then the elements fall in the order x-2y+z, x-y, x-z, x-y+z, x, x+y-z, x+z x+y, x+2y-z.

        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.

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.

      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

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.

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 1-26 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"; }

    Cheers - L~R

      Nit. There are actually 1648 magic squares. Rotation and reflection can generate the rest from the 206 that you are producing.
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"; }

    Cheers - L~R

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://755502]
Approved by ww
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (8)
As of 2014-08-29 23:40 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (289 votes), past polls