#!/usr/bin/perl

use strict;
use Tree::Simple;
use Time::HiRes 'time';

# get arguments

my $interactive;
my $dictfile;

if (@ARGV and $ARGV[0] eq "-i") {
  shift;

  $interactive = 1;
  $dictfile = shift;
} else {
  $dictfile = pop
    if (@ARGV > 2);
}

$dictfile ||= "zcat words.gz |";

die "Usage: $0 { -i | <word1> <word2> } [dictfile]\n"
  unless (($interactive && !@ARGV) || (@ARGV == 2));

# load dictionary

my $dict = load_dictionary ($dictfile);

# go

$| = 1;

if ($interactive) {
  while (1) {
    print "> ";
    $_ = <>;

    last if (!defined ($_) or ($_ =~ /^quit\s*$/i));

    chomp;
    my ($word1, $word2, @rest) = split / /, $_;

    unless ($word1 && $word2 && !@rest) {
      print "Error: enter two words, separated by a space\n";
      next;
    }

    show_ladder ($word1, $word2, $dict);
  }
} else {
  show_ladder (@ARGV, $dict)
    || exit 1;
}

###############################################################################

sub load_dictionary {
  my ($dictfile) = @_;
  my $dict = [];

  open (DICT, $dictfile)
    or die "Error reading dictionary ($dictfile): $!\n";

  while (<DICT>) {
    chomp;
    push @$dict, $_;
  }

  close (DICT);
  return $dict;
}

sub show_ladder {
  my ($word1, $word2, $dict) = @_;

  # make sure the words are the same length

  unless (length $word1 == length $word2) {
    print "Error: words must be the same length\n";
    return;
  }

  # make sure both words are in dictionary

  for my $word ($word1, $word2) {
    unless (grep { $word eq $_ } @$dict) {
      print "Error: $word not found in dictionary\n";
      return;
    }
  }

  # limit the dictionary to words of the correct length

  my $newdict = [grep { length ($_) eq length ($word1) } @$dict];

  # find the ladder

  my $t1 = time;
  my @ladder = ladder ($word1, $word2, $newdict);
  my $t2 = time;

  my $time = $t2 - $t1;

  unless (@ladder) {
    printf "Error: no ladder found from $word1 to $word2 (in %.03fs)\n", $time;
    return;
  }

  # print it out

  #printf "$word1 -> $word2 in %d steps (%.03fs):\n", $#ladder, $time;
  print "$_\n" for @ladder;

  return @ladder;
}

sub _neighbors {
  my ($word, $dict) = @_;

  # build a list of patterns that match neighboring words. for
  # example, if the word is "love", the patterns are:
  #
  #   .ove
  #   l.ve
  #   lo.e
  #   lov.

  my @patterns = ($word) x length $word;
  substr ($patterns[$_], $_, 1, ".")
    for (0..$#patterns);

  # now build single regular expression that can be used to pull all
  # neighboring words out of the dictionary. for "love", this regular
  # expression is:
  #
  #   ^.ove$|^l.ve$|^lo.e$|^lov.$

  my $regex = join "|", map { "^$_\$" } @patterns;

  # find all words in the dictionary that match this pattern, other
  # than the starting word (i.e., all neighboring words). the match is
  # case-insensitive, so "Rock" is considered a neighbor of "rack"

  return (grep { /$regex/i && uc ($_) ne uc ($word) } @$dict);
}

sub ladder {
  my ($word1, $word2, $dict) = @_;

  # build a tree of neighbors and search it breadth-first. the root of
  # the tree is the starting word. on each iteration, take each of the
  # leaf nodes and make a child for each of its neighbors. we're done
  # when either the target word appears as a neighbor of one of the
  # leaf nodes, or none of the leaf nodes yields any neighbors.

  my %seen   = ($word1 => 1);
  my $tree   = Tree::Simple->new ($word1, Tree::Simple->ROOT);
  my @leaves = ($tree);

  while (1) {
    my @next_leaves = ();

    foreach my $leaf (@leaves) {
      foreach my $neighbor (_neighbors ($leaf->getNodeValue, $dict)) {

        # all words in %seen are words we've already found a faster
        # path to, so skip them to avoid going in circles

        next if $seen{$neighbor};

        # did we find the target word as one of this leaf's neighbors?

        if ($neighbor eq $word2) {

          # if so, then we're done; build the path by walking back up
          # the tree

          my @final = ($neighbor);
          my $cur = $leaf;

          while ($leaf->getNodeValue ne $word1) {
            unshift @final, $leaf->getNodeValue;
            $leaf = $leaf->getParent;
          }

          return ($word1, @final);
        }

        # mark this word as seen, and add it to the tree

        $seen{$neighbor} = 1;
        my $new_leaf = Tree::Simple->new ($neighbor, $leaf);

        # make a list of leaf nodes that will be used for the next
        # iteration

        push @next_leaves, $new_leaf;
      }
    }

    # if none of the leaves had any usable neighbors, then it's time
    # to give up

    return () unless @next_leaves;
    @leaves = @next_leaves;
  }
}
