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;
}
[download]