#! /usr/bin/perl -wl
use strict;
use warnings;

my @names = qw(JOHN MARTY PAUL SHEILA SMACK SUZY ELSA);

for my $name (@names) {
  my @d = map {ord($_) - ord("A") + 1} split //, $name;
  my @solution = find_square(@d);
  if (@solution) {
    printf "%s:\n  %2d %2d %2d\n  %2d %2d %2d\n  %2d %2d %2d\n",
      $name, @solution;
    printf "\n  %s  %s  %s\n  %s  %s  %s\n  %s  %s  %s\n\n",
      map chr($_+ord("A")-1), @solution;
  }
  else {
    print "$name: no solution\n";
  }
}

# All solutions look like:
#
#    x+y    x-z  x-y+z
#   x-2y+z   x  x+2y-z
#   x+y-z   x+z  x-y
#
# Up to rotation and reflection we may insist that:
#
#   0 < z < y
#   z != y-z
#
# If 2z < y they are, in order:
#
#   x-2y+z, x-y, x-y+z, x-z, x, x+z, x+y-z, x+y, x+2y-z
#
# Otherwise if y < 2z they are:
#
#   x-2y+z, x-y, x-z, x-y+z, x, x+y-z, x+z x+y, x+2y-z
#
# This falls in the range 1..26 if 0 < x-2y+z and x+2y-z < 27.
#
# So 4y-2z < 25 with z < y means y < 13.
sub find_square {
  my @d = sort {$a <=> $b} @_;

  my $min_range = $d[-1] - $d[0];

  # As shown above, y < 13, but the lower limit is more complicated.
  # So work down from there.
  my $y = 13;
Y: while (1) {
    $y--;
    last Y if 4*$y-2 < $min_range;

    # y < z is trivial, but the lower limit is complicated.
    # Again we were down from the top.
    my $z = $y;
Z:  while (1) {
      $z--;
      next Y if 4*$y-2*$z > 25;
      next Y if $z < 1;

      my @in_order;
      if ($z+$z > $y) {
        @in_order = (
          -2*$y + $z,
          -$y,
          -$z,
          -$y + $z,
          0,
          $y - $z,
          $z,
          $y,
          2*$y - $z,
        );
      }
      elsif ($z+$z < $y) {
        @in_order = (
          -2*$y + $z,
          -$y,
          -$y + $z,
          -$z,
          0,
          $z,
          $y - $z,
          $y,
          2*$y - $z,
        );
      }
      else {
        next;
      }

      # Sanity check for our logic.  Can be removed.
      for (1..$#in_order) {
        if ($in_order[$_-1] >= $in_order[$_]) {
          print "y: $y, z:$z\n";
          die "Out of order: @in_order";
        }
      }

      # i is the index $d[0] matches at, which tells us $x.
I:    for my $i (0..$#in_order) {
        my $x = $d[0] - $in_order[$i];

        # Sanity check our number range.
        # If we're out of range and increasing $i will not help,
        # then move to a different ($x, $z), otherwise only
        # increment $i.
        next Z if $x + $in_order[0] < 1;
        next I if $x + $in_order[-1] > 26;
        next Z if $x + $in_order[-1] < $d[-1];

        # We match the lowest number, can we find the rest?
        # We search with "zipping" logic.
        my $p_d = my $p_o = 1;
        while ($p_d < @d) {
          if ($x + $in_order[$p_o] < $d[$p_d]) {
            # Perhaps the next number will match our digit?
            $p_o++;
          }
          elsif ($x + $in_order[$p_o] > $d[$p_d]) {
            # $d[$p_d] is not anywhere in our square.
            next I;
          }
          else {
            # One more digit matched.
            $p_o++;
            $p_d++;
          }
        }

        # If we got here we have a solution!  Return it in the
        # right order for a square.
        return (
          $x + $y,
          $x - $z,
          $x - $y + $z,
          $x - 2*$y + $z,
          $x,
          $x + 2*$y - $z,
          $x + $y - $z,
          $x + $z,
          $x - $y,
        );
      }
    }
  }

  return;
}