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.
update: revised to improve performance. The following takes under 2 seconds running with Devel::NYTProf on my 2.4G Pentium / CentOS system and sub-second without the profiler.
update2: I hadn't noticed, until reviewing Limbic~Region's two subsequent posts, that I had introduced a fault in my last update, now fixed without significant impact on performance.
use strict;
use warnings;
use Algorithm::Combinatorics;
use Algorithm::FastPermute;
use Data::Dumper;
#
# The magic square is a 3x3 matrix
#
# 1 2 3
# 4 5 6
# 7 8 9
#
# All rows, all columns and both diagonals sum to n.
# Therefore we have 8 equations in 10 unknowns.
# In addition, one of the equations is not independent,
# so we have 7 independent equations in 10 unknowns:
# leaving us with 3 degrees of freedom.
#
# Generate all permutations of all combinations of the number of free
# variables taken from the set [1..26] (i.e. the alphabet as encoded).
#
# For each such permutation, solve the system of equations for the
# determined variables and push the vector of values into @solutions,
# accumulating all solutions for the magic square.
#
# Reject all solutions where magic square values are not integers
# in the range 1 to 26 inclusive.
#
my @solutions;
my @coefficients = (
[ -2/3, - 2/3, 1/3 ],
[ -2/3, 1/3, -2/3 ],
[ 1/3, -2/3, -2/3 ],
[ 2/3, -1/3, -4/3 ],
[ -1/3, -1/3, -1/3 ],
[ -4/3, -1/3, 2/3 ],
);
foreach my $combination (
Algorithm::Combinatorics::combinations([1..26],3)
) {
my @array = ( @$combination );
Algorithm::FastPermute::permute {
my @solution = ( 0, 0, 0, 0, 0, 0, @array);
my $good = 1;
foreach my $n (0..5) {
$solution[$n] = sprintf("%5.2f", - (
$solution[6] * $coefficients[$n]->[0] +
$solution[7] * $coefficients[$n]->[1] +
$solution[8] * $coefficients[$n]->[2]
));
if(
$solution[$n] !~ m/\.00$/ or
$solution[$n] < 0.999 or # tolerance for quantizatio
+n error
$solution[$n] > 26.001 # tolerance for quantizatio
+n error
) {
$good = 0;
last;
}
}
push(@solutions, [ @solution ] ) if($good);
} @array;
}
#
# For each name, check wich of the solutions include all the
# letters of the name.
#
foreach my $name (
qw( elsa john marty paul sheila smack suzy )
) {
my @nameset = map { ord($_) - ord('a') + 1 } sort split(//,$name);
my @namesolutions = ();
SOLUTION: foreach my $solution (@solutions) {
foreach my $x (@nameset) {
next SOLUTION unless(grep { $_ == $x } @$solution);
}
push(@namesolutions, $solution);
}
if(@namesolutions) {
print "Solutions for $name: " . scalar(@namesolutions) . "\n";
foreach my $solution (@namesolutions) {
display_solution($solution);
}
} else {
print "No solutions for $name\n\n";
}
}
exit(0);
sub display_solution {
my $solution = shift;
my @letters = map{ chr( $_ + 96 ) } @$solution;
printf("%3d %3d %3d %s %s %s\n",
$solution->[0], $solution->[1], $solution->[2],
$letters[0], $letters[1], $letters[2]);
printf("%3d %3d %3d %s %s %s\n",
$solution->[3], $solution->[4], $solution->[5],
$letters[3], $letters[4], $letters[5]);
printf("%3d %3d %3d %s %s %s\n",
$solution->[6], $solution->[7], $solution->[8],
$letters[6], $letters[7], $letters[8]);
print "\n";
}
Total numbers of solutions are: Elsa - 24, John - 72, Marty - 8, Paul - 0, Sheila - 8, Smack - 8, Suzy - 16.