John = 10 15 8 14 3 16 8 14 9 4 10 2 15 C P H N I D J B O Marty = 13 1 18 20 25 6 25 8 15 13 11 18 1 20 F Y H O M K R A T Sheila = 19 8 5 9 12 1 5 23 8 15 12 9 16 1 19 E W H O L I P A S Smack = 19 13 1 3 11 3 21 9 17 11 5 13 1 19 C U I Q K E M A S Suzy = 19 21 26 25 15 26 19 24 20 16 21 14 25 O Z S X T P U N Y Elsa = 5 12 19 1 3 19 8 15 10 5 12 1 17 C S H O J E L A Q no solution: Paul (16 1 21 12) #### 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; }