use strict;
use warnings;

my $NUMBER_BASE = ord('a') - 1;
my $aNoMagic = findUnmagicNames(['Shiela'], 26);
print "no solution: @$aNoMagic\n";


#---------------------------------------------------------------------
+-

sub findUnmagicNames {
  my ($aNames, $iMax) = @_;

  my @aNoSolutions;
  foreach my $sName (@$aNames) {
    my $aNumbers = getNumbersFromName($sName);
    my $aMagic = validateSeed($aNumbers, $iMax);

    if ($aMagic) {
      print sprintf("%-8s= %s", $sName, "@$aNumbers\n");
      printSolution($aMagic);
    }else {
      push(@aNoSolutions, "$sName (@$aNumbers)");
    }
  }
  return \@aNoSolutions;
}

sub printSolution {
  my $aNumbers = shift;
  my $sMatrix='';
  for (my $i=0; $i < 3; $i++) {
    my $aRow = $aNumbers->[$i];
    $sMatrix .= sprintf("   %3s%3s%3s\n"
                        , $aRow->[0], $aRow->[1], $aRow->[2]);
  }
  $sMatrix .= "\n";
  for (my $i=0; $i < 3; $i++) {
    my $aRow = $aNumbers->[$i];
    $sMatrix .= sprintf("   %3s%3s%3s\n"
                        , uc chr($aRow->[0] + $NUMBER_BASE)
                        , uc chr($aRow->[1] + $NUMBER_BASE)
                        , uc chr($aRow->[2] + $NUMBER_BASE));
  }
  print $sMatrix;
}

#---------------------------------------------------------------------
+-
# This is supposed to check whether or not a set of five can be turned
# into a magic square, but it is too restrictive: it forgets about the
# possibility of:
#   X X
#   X   X
#       X

sub getMagicSquare {
  my ($aNumbers, $iMax) = @_;
  my ($x11, $x12, $x13, $x21, $x31, $sum);

  #can these five numbers be part of a magic square?
  #  $sum = $x11 + $x12 + $x13;
  #  $sum = $x11 + $x21 + $x31;
  #  $total = 2*$sum - $x11;

  my $bOk = 0;
  my $sumAll = 0;
  foreach (@$aNumbers) { $sumAll += $_; };
  for my $i (0..$#$aNumbers) {
    $x11 = $aNumbers->[$i];
    my $sumTwice = $sumAll + $x11;
    next if $sumTwice %2 ;
    $sum = $sumTwice/2;

    my @aInUse = ($i);
    my $j = getNotInUse(\@aInUse, $#$aNumbers);
    $x21 = $aNumbers->[$j];
    push @aInUse, $j;

    $x31 = $sum - $x11 - $x21;
    next if ($x31 < 1) || ($x31 > $iMax);
    while ($j < $#$aNumbers) {
      $j++;
      last if $aNumbers->[$j] == $x31;
    }
    next if (($#$aNumbers < $j) || isDup($j, \@aInUse));
    push @aInUse, $j;

    $j = getNotInUse(\@aInUse, $#$aNumbers);
    $x12 = $aNumbers->[$j];
    push @aInUse, $j;

    $x13 = $sum - $x11 - $x12;
    next if ($x13 < 1) || ($x13 > $iMax);
    $j = getNotInUse(\@aInUse, $#$aNumbers);
    next if ($x13 != $aNumbers->[$j]);
    $bOk = 1;
    last;
  }
  return undef unless $bOk;
  #print "5 is OK <@$aNumbers>\n";

  my @aSolution = ($x11, $x12, $x13, $x21, $x31);
  my $x22 = $sum - $x13 - $x31;
  return undef if (($x22 < 1) || ($x22 > $iMax) || isDup($x22, \@aSolu
+tion));
  push @aSolution, $x22;
  #print "6 is OK <@aSolution>\n";

  my $x33 = $sum - $x11 - $x22;
  return undef if (($x33 < 1) || ($x33 > $iMax) || isDup($x33, \@aSolu
+tion));
  push @aSolution, $x33;
  #print "7 is OK <@aSolution>\n";

  my $x23 = $sum - $x21 - $x22;
  return undef if ($x23 < 1) || ($x23 > $iMax) || isDup($x23, \@aSolut
+ion);
  push @aSolution, $x23;
  #print "8 is OK <@aSolution> sum=<$sum> <$x21> <$x22> <$x23>\n";

  my $x32 = $sum - $x33 - $x31;
  return undef if ($x32 < 1) || ($x32 > $iMax) || isDup($x32, \@aSolut
+ion);
  push @aSolution, $x32;

  print "9 is OK <@aSolution> sum=<$sum>\n";
  return undef if $sum != ($x13 + $x23 + $x33);
  return [[$x11,$x12,$x13],[$x21,$x22,$x23],[$x31,$x32,$x33]];
}

#---------------------------------------------------------------------
+-

sub getNotInUse {
  my ($aInUse, $iMax) = @_;
 pick:
  for (my $i=0; $i <= $iMax; $i++) {
    for (my $j=0; $j <= $#$aInUse; $j++) {
      next pick if $i == $aInUse->[$j];
    }
    return $i;
  }
  return undef;
}

#---------------------------------------------------------------------
+-

sub getNumbersFromName {
  my $sName = shift;
  return [ map { ord(lc($_)) - $NUMBER_BASE; } split(//,$sName) ];
}

#---------------------------------------------------------------------
+-

sub isDup {
  my ($iFind, $aNumbers) = @_;
  for(my $i=0; $i<$#$aNumbers; $i++) {
    return 1 if ($iFind == $aNumbers->[$i]);
  }
  return 0;
}

#---------------------------------------------------------------------
+-

sub validateSeed {
  my ($aSeed, $iMax) = @_;
  my $iSeedCount = scalar(@$aSeed);
  my $iMissing = 6 - $iSeedCount;
  return getMagicSquare($aSeed, $iMax) unless $iMissing;

  #for each possible completion of $aSeed into @aSix
  #verify (note: this is still buggy - my brain can't do loops today)

  my @aSix = @$aSeed;
  my $iLast = $iMissing - 1;
  my $i = 0;
  my $iPick=0;
  my @aPick;
  while (1) {
    print "1: last=$iLast at=$i pick=$iPick <@aSix>\n";
    if ($iLast < $i) {
      my $aMagic = getMagicSquare(\@aSix, $iMax);
      return $aMagic if $aMagic;
      $i--;
    }

    while (isDup(++$iPick, \@aSix) && ($iPick < $iMax)) {};
    if ($iPick <= $iMax) {
      $aSix[$iSeedCount + $i ] = $iPick;
      $aPick[$i] = $iPick;
      $i++;
    } else {
      $aPick[$i] = 0;
      $iPick = 0;
      last unless $i;
      $i--;
    }
    die "How'd this grow so big? <@aSix>" if (scalar(@aSix) > 6);
  }
  return undef;
}
[download]