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?
use strict;
use warnings;
use strict;
use warnings;
my $NUMBER_BASE = ord('a') - 1;
my @aNames =qw(John Marty Paul Sheila Smack Suzy Elsa);
printMagicNames(\@aNames, 26);
#==================================================================
# MAIN FUNCTION
#==================================================================
sub printMagicNames {
my ($aNames, $iMax) = @_;
my @aNoSolutions;
foreach my $sName (@$aNames) {
my $aRequired = getNumbersFromName($sName);
my $aMagic = getMagicSquare($aRequired, $iMax);
if ($aMagic) {
print sprintf("%-8s= %s", $sName, "@$aRequired\n");
printSolution($aMagic);
}else {
push(@aNoSolutions, "$sName (@$aRequired)");
}
}
local $"="\n ";
print "\nno solution:\n @aNoSolutions\n";
}
#==================================================================
# SUPPORTING FUNCTIONS
#==================================================================
#---------------------------------------------------------------------
+-
sub getNumbersFromName {
my $sName = shift;
return [ map { ord(lc($_)) - $NUMBER_BASE; } split(//,$sName) ];
}
#---------------------------------------------------------------------
+-
sub getMagicSquare {
my ($aRequired, $iMax) = @_;
# $sumAll=3*$sumDiag
my $iLimitI=$iMax-2;
my $sumMax=0; $sumMax+=$_ for (($iMax-8)..$iMax);
$sumMax = int($sumMax/3);
#get all possible diagonals ($i,$j,$k)
for my $i (1..$iLimitI) {
for my $j ($i+1..($iLimitI+1)) {
my $iLimitK = $sumMax - $i - $j;
$iLimitK = $iMax if ($iLimitK > $iMax);
for my $k ($j+1..$iLimitK) {
my $aMagic = getMagicSquareFromDiagonal
([$i,$j,$k], $aRequired, $iMax);
return $aMagic if $aMagic;
}
}
}
return undef;
}
sub getMagicSquareFromDiagonal {
my ($aDiagonal, $aRequired, $iMax) = @_;
my @aDiagonal = @$aDiagonal;
# 3*$sum=($x11+$x12+$x13+$x21+$x22+$x23+$x31+$x32+$x33);
# 0 = $x11+$x33-$x31-$x13;
# 3*$sum=2*($x11+$x33) + $x12+$x21+$x22+$x23+$x32
# 3*$sum=2*($x11+$x33) + $x22 + $sumMiddleEdge
# 2*$sum= $sumMiddleEdge + 2*$x22;
# $sumMiddleEdge = 2*$sum - 2*$x22;
# 3*$sum=2*($x11+$x33) + $x22 + 2*$sum - 2*$x22;
# $sum=2*($x11+$x33) - $x22;
# $x11+$x22+$x33=2*($x11+$x33) - $x22
# 2*$x22=$x1+$x33
my $sum = 0; $sum += $aDiagonal->[$_] for 0..2;
for my $i (0..2) {
# prescreen the diagonal using the above
# calculated constraints
my $x11 = $aDiagonal->[$i];
my $x22 = $aDiagonal->[($i+1)%3];
my $x33 = $aDiagonal->[($i+2)%3];
#the uncommented test may be marginally faster
# - but timing results are not consistent
#next unless $sum == 2*($x11+$x33)-$x22;
next unless ($x11+$x33) == (2*$x22);
# get another corner: if we have one more corner
# we can calculate the remaining cell values
# Another speed improvement - good for about 30% increase
# Note: we only need to search half of the range 1..$iMax
# * if $x is not valid, then $sum - $x is also not valid
# * if $x is valid, then $sum - $x is just the mirror image
my $sumCattyCorners = $x11+$x33;
my $iLimit = $sumCattyCorners%2
? ($sumCattyCorners+1)/2 : $sumCattyCorners/2;
for my $x13 (1 .. $iLimit) {
#for my $x13 (1 .. $iMax) {
my $aSolution = [$x11,$x22,$x33];
next if isInSolution($aSolution, $x13);
push @$aSolution, $x13;
my $x31 = $sumCattyCorners - $x13;
next unless addToSolution($aSolution, $x31, $iMax);
my $x12 = $sum - $x11 - $x13;
next unless addToSolution($aSolution, $x12, $iMax);
my $x21 = $sum - $x11 - $x31;
next unless addToSolution($aSolution, $x21, $iMax);
my $x32 = $sum - $x31 - $x33;
#print "Diagonal: <$x11 $x22 $x33> <$x32> <@$aSolution>\n";
next unless addToSolution($aSolution, $x32, $iMax);
my $x23 = $sum - $x22 - $x21;
next unless addToSolution($aSolution, $x23, $iMax);
next unless $sum == ($x12+$x22+$x32);
next unless $sum == ($x13+$x23+$x33);
my $bFound=1;
for (@$aRequired) {
next if isInSolution($aSolution, $_);
$bFound = 0;
last;
}
next unless $bFound;
return [$x11,$x12,$x13,$x21,$x22,$x23,$x31,$x32,$x33];
}
}
return undef;
}
sub addToSolution {
my ($aSolution, $iAdd, $iMax) = @_;
return 0 if ($iAdd < 1) || ($iAdd > $iMax)
|| isInSolution($aSolution, $iAdd);
push @$aSolution, $iAdd;
return 1;
}
sub isInSolution {
my ($aSolution, $iFind) = @_;
foreach (@$aSolution) {
return 1 if ($_ == $iFind);
}
return 0;
}
#---------------------------------------------------------------------
+-
sub printSolution {
my $aNumbers = shift;
my $sMatrix='';
for (my $i=0; $i < 3; $i++) {
$sMatrix .= sprintf(" %3s%3s%3s\n"
, $aNumbers->[3*$i]
, $aNumbers->[3*$i+1]
, $aNumbers->[3*$i+2]);
}
$sMatrix .= "\n";
for (my $i=0; $i < 3; $i++) {
my $aRow = $aNumbers->[$i];
$sMatrix .= sprintf(" %3s%3s%3s\n"
, uc chr($aNumbers->[3*$i] + $NUMBER_BASE)
, uc chr($aNumbers->[3*$i+1] + $NUMBER_BASE)
, uc chr($aNumbers->[3*$i+2] + $NUMBER_BASE));
}
print $sMatrix;
}